perm filename MUSIC.FAI[MUS,SYS] blob
sn#171236 filedate 1975-08-01 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00055 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00006 00002 TITLE MUSIC
C00011 00003 INPUT ROUTINE. CALL INITIALLY WITH PUSHJ P,SETUP
C00014 00004 RIN: ILDB TIB+1 GET FILE NAME
C00016 00005 AER1: MOVEI DEV1MS ERROR ROUTINE FOR NOT AVAILABLE
C00018 00006 SIXOUT: TLO 440600 MAKE BYTE POINTER
C00020 00007 SUBTTL ALGOL SCANNER -- 9/8/66 D. POOLE
C00023 00008 MOVE A,ACCUM PREPARE TO SEARCH TABLES.
C00026 00009 FOOSCH: LDB B,[POINT 6,ACCUM,17]
C00028 00010 SNUM1: MOVEI C,0 NUMBER SCANNER.
C00030 00011 NOW SEARCH NUMBER TABLE FOR THE NUMBER.
C00032 00012 RESERVED WORD TABLE SEARCHER.
C00034 00013 THE CHARACTER CONVERSION TABLE -- GOOD BITS FOR EVERYONE !
C00036 00014 DEFINE PUT1 (N,Y)
C00038 00015 MORE BITS AND PARAMETERS.
C00040 00016 TEMPSY: EXP TMPS1Z
C00045 00017 FMPSA: EXP TMPS4 LINEN.
C00047 00018 HERE ARE SOME WONDERFUL UNIT GENERATORS.
C00056 00019 REVERBERATION UNIT GENERATORS.
C00060 00020 MORE GENERATORS, SPECIFICALLY LINEN (THE INFAMOUS) AND VALUE
C00064 00021 RANDOM NUMBER GENERATORS.
C00067 00022 PLIST: BLOCK LPLIST
C00068 00023 THIS IS THE MULTIPLE-FEEDBACK REVERBERATOR.
C00070 00024
C00072 00025 ***** COMPX BEGINS HERE **** ROUTINES TO EMIT CODE AND STUFF TO OUTPUT BUFFERS.
C00075 00026 THIS HERE IS THE COMPILER !
C00077 00027 PRIM2: CAMN A,MINV UNARY MINUS ?
C00080 00028 PROCESS A FUNCTION CALL.
C00083 00029 HERE ARE THE GLORIOUS, SUPER-INTELLIGENT, SCHIZOPHRENIC
C00086 00030 HA! I BET YOU THOUGHT WE WERE DONE, DIDN'T YOU ?
C00088 00031 GMURK CLEVERLY GPONDERS THE TOP TWO OPERANDS,
C00091 00032 STILL MORE KLUGES. PAUSE TO GET YOUR BREATH NOW.
C00094 00033 GETAC SEARCHES FOR A FREE AC, EITHER I-TIME OR
C00097 00034 MORE GENERATORS.
C00099 00035 GFUNC: GENERATE A FUNCTION CALL.
C00102 00036 UTILITY RUOTINE TO ENTER AN ITEM IN THE MAIN SYMBOL TAB.
C00104 00037 INITIALIZATION OF THE COMPILER.
C00106 00038 SYNTAX ANALYZER.
C00109 00039
C00111 00040 DF5: CAME A,COMMAV ARE THERE MORE DEFINITIONS ?
C00114 00041 DF2A: TLNE A,DF+NUMFLG
C00117 00042 MORE SYNTAX ANALYZER. COMPILE AN INSTRUMENT DEFINITION.
C00120 00043 CINS4: PUSHJ P,STMT1 ITS NOT A UNIT GEN. CALL.
C00124 00044 THE WONDERFUL, WINNING LOADER.
C00127 00045 MORE LOADER (BUT NOT MUCH MORE, YOU WILL NOTICE !).
C00129 00046 DARR: PUSH P,[0] DEFINE SOME ARRAYS.
C00132 00047 HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.
C00135 00048 THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
C00138 00049 MORE OF PINS.
C00141 00050 THIS ROUTINE GENERATES SAMPLES BY CALLING THE
C00144 00051 RANDOM ROUTINES TO HANDLE THE SAMPLE OUTPUT BUFFER.
C00149 00052 ERROR HANDLING(?) ROUTINES.
C00151 00053
C00152 00054 RDNUM: 0 NUMBER READER FOR FOOTRAN ROUTINES.
C00155 00055 REST1: MOVEI TEMPSY
C00157 ENDMK
C⊗;
TITLE MUSIC
;;;****** AS OF JAN. 12, 1971 *********
; XGP INIT ADDED JAN 1974
↓T←1
T1←2
T2←3
T3←4
A←5
B ←6
C←7
D←10
E←11
F←12
H←14
OSP←13
↓P←15
↓FL←17
NACS←←5
NFACS←←4
INSXR←←NFACS-1
SSPCF←←10
SDFLG←←20
SNUMF←←40
FIXFLG←←1000
FLTFLG←←2000
DF←←400000
NUMFLG←←FIXFLG+FLTFLG
SSPC2F←←4000
RFLG←←0 ;$$$%%&%$###""##$%$$$$$
DECLBIT←←400
RVBT←←400
PRVBT←←11
MULBIT←←1
ADDBIT←←2
FOOBIT←←100
INSBIT←←40
UGBIT←←4000
FPARBT←←200
SRACBT←←10000
SIACBT←←20000
GPBIT←←FOOBIT ;NOT I OR X.
FUNBIT←←40000
SWVBT←←100000 ;DO NOT CHANGE ! SEE GFUNC.
VRBLBT←←200000
;; RELOCATION AND FIXUP BITS .
.FXBTS←←1
LFXBTS←←2
VRELBT←←14+1
RRELBT←←4+1
IRELBT←←10+1
;; FLAGS (RIGHT HALF):
CSBRBT←←1
SFOOBT←←10
USBRBT←←2
GFUNCF←←4
EXTFLG←←40
ARRFLG←←20
RVFLG←←100
RESTART←←200
;FLAGS (LEFT HALF).
ERRFLG←←1
MINFLG←←2
SNUMF1←←4
NOSTAR←←10
DTFLG←←20
;; PARAMETER DESCRIPTOR BITS:
FAOPAR←←1
FDPARB←←4
FDPARC←←5
COFF←←1000 ;PI CHANNEL OFF.
CON←←2000
DACHN←←100 ;PI CHANNEL 1.
LRFXBT←←200000 ;LEFT HALF REPLACEMENT FIXUP BIT.
RRFXBT←←100000 ;RIGHT HALF.
SWAPBT←←40000 ;SWAPPED FIXUP.
;;;;; 5/74 DEFINE IOWD (A,B) <XWD -A,B-1>
OPDEF EXP [0]
OPDEF FIX [XWD 247000,0] ;FOR PDP10 ONLY. REMOVE WITH DDT FOR PDP6
;*********↑↑↑↑↑↑↑↑↑
OPDEF OUTCHR [XWD 51040,0]
;;UUOSER: 0
;; MOVEM A,SAVEA#
;; HLRZ A,40
;; CAIL A,2000
;; JRST FIXER
;; MOVE A,SAVEA
;; JSR ERR1
;; JRSTF @UUOSER
BEGIN SAVER
; (INSERTED 11/3/69)
; TO DUMP CORE IMAGE
; CREATE A FILE OF THE CURRENT CORE IMAGE.
; PICK UP THE USER'S INPUT FILE NAME STORED
; IN DLK AND CREATE A FILE CALLED:
; "NAME.SAV"
; WHERE NAME IS THE INPUT FILE NAME.
;
; THE SWAP UU0 WILL BE USED WHICH CLOSES ALL
; ACTIVE DEVICES.
;
; ACCUMULATORS 0 AND T WILL BE CLOBBERED BY THIS
; ROUTINE. ALL OTHERS WILL BE SAVED AND RESTORED.
INTERNAL SAVER
↑SAVER: 0
MOVE 0,SCP ;BASE OF INPUT BUFFER
HRRZ T,IBUF ;CURRENT BUFFER
SUBI 0,-BUF1-1(T) ;DIFFERENCE
MOVEM 0,PLIST+LPLIST-10
MOVEM 17,ACS+17 ;SAVE REGISTERS
MOVEI 17,ACS
BLT 17,ACS+16
SKIPN T,DLK ;INPUT FILE NAME
MOVSI T,'SAV'
MOVEM T,SWPTBL+1
MOVSI T,SWPTBL ;ADDR OF 5 WORD BLOCK IN LEFT PART OF T
CALL T,[SIXBIT /SWAP/]
RETR: MOVE P,[XWD -10,PLIST+LPLIST-10] ;PICK UP ACCUM P
MOVEI FL,RESTART ;RESTORE RESTART FLAG
SOS RECCT ;BACK UP TO PREVIOUS INPUT RECORD.
PUSHJ P,SETUP ;JUMP TO RESTORE FILES
POP P,SCP
MOVEI GO
HRRM JOBSA
MOVSI 17,ACS ;RESTORE REGISTERS
BLT 17,17
JRA 16,(16)
ACS: BLOCK 20 ;REGISTER SAVE AREA
SWPTBL: SIXBIT /DSK/ ;DEVICE FOR SWAP
0 ;FOR FILENAME
SIXBIT /SAV/ ;FILENAME.SAV
RETR ;CORE SIZE (0=USE WHAT YOU NEED)
0 ;END OF LIST
BEND SAVER
;INPUT ROUTINE. CALL INITIALLY WITH PUSHJ P,SETUP
;WILL READIN DTA# AND FILE NAME. GET CHRS BY
;ILDB IBUF+1. NEXT BUFFER BY INPUT DT,0.
;;;EXTERNAL IFIX
EXTERNAL SMPLS
EXTERNAL READIN
TTY←←10
DT←←11
ADCHN←←12
SETUP: CALL [SIXBIT /RESET/]
SETUP1: INIT TTY,1
SIXBIT /TTY/
XWD TOB,TIB
CALL [SIXBIT /EXIT/]; ERROR CONDITION
MOVSI 400000
ANDCAM TIBUF+1 ;MARK INPUT BUFFERS EMPTY.
ANDCAM BUF1+1
ANDCAM BUF2+1
ANDCAM BUF3+1
HRRI TIBUF+1 ;INIT. BUFFER POINTERS.
MOVEM TIB
HRRI TOBUF+1
MOVEM TOB
OUTPUT TTY,1; SEE THE HAPPY SYSTEM
;;COLGATE OUTPUT TTY,
TRNE FL,RESTART ;ARE WE RESTARTINIG ?
JRST SET4 ;YES.
MOVEI IMS
JSR TXTOUT; A LF/CR *
;; 5/74 INPUT TTY,0; THE DTA # AND NAME
;; SETZM DNAM
;; MOVE 2,[POINT 6,DNAM]
;; MOVEI T2,6
;;SET3: ILDB TIB+1
;; CAIN ":"
;; JRST SET4
;; SUBI 40
;; IDPB 2
;; SOJG T2,SET3
;*******↓↓↓↓↓ 5/74
EXTERNAL FILBRK,DLK,ASTR
INTERNAL DEV
SETZM ASTR
JSA 16,FILBRK
MOVE T2,[SIXBIT/TTY/]
SKIPN DLK
MOVEM T2,DNAM
;******↑↑↑↑↑
SET4: INIT DT,1
DNAM:DEV: SIXBIT /DTA/
XWD 0,IBUF ;NO OUPUT ON THIS DEVICE.
JRST AER1
MOVE [XWD 400000,BUF1+1] ;SET UP BUFFER
MOVEM IBUF ;HEADER SO SYSTEM WILL USE OUR BUFFERS.
MOVSI 700
MOVEM SCP ;BYTE SIZE.
;; 5/74 SETZM DLK+3 ;TO READ FILES OFF DSK
TRZE FL,RESTART
JRST SETIN
;**** NEXT 2 ARE FOR SAVER
MOVEI T,1
MOVEM T,RECCT
;; 5/74 MOVE T1,[POINT 6,DLK]
;; SETZM DLK
;; SETZM DLK+1
;; MOVEI T2,12
JRST SETIN
;***********↑↑↑↑↑
RIN: ILDB TIB+1; GET FILE NAME
CAIN 15
JRST SETIN
CAIN "."; AN EXTENSION
JRST SETEX
SUBI 40
IDPB T1
SOJG T2,RIN
JRST SETIN
TIB: 0
POINT 7,0,35
0
TOB: 0
POINT 7,0,35
0
TIBUF: 0
XWD 21,.
BLOCK 22
TOBUF: 0
XWD 21,.
BLOCK 22
;THIS IS NOW IN FILBRK DLK: BLOCK 4
IBUF: XWD 400000,BUF1+1; MAGIC TO KEEP SYSTEM
SCP: POINT 7,0,35; HAPPY
ICCNT: 0 ;BUFFER CHAR. COUNT.
SETEX: TLZ T1,770000
JRST RIN
SETIN: MOVE 0,DLK+3 ;TO SAVE P,PN
LOOKUP DT,DLK; GET FILE SETUP
JRST NER; NON-EX FILE
MOVEM 0,DLK+3 ;PUTS BACK P,PN
PUSHJ P,RDBUF ;GET FIRST BUFFER
MOVE BUF1+3 ;LINE NO. FIRST ?
TRNE 1
AOS SCP ;YES; ADVANCE SCP PAST IT.
SETZM SNCHR
SETZM FOONLY# ;BARF !!
POPJ P,; DONE
BUF1: 0
XWD 201,BUF2+1
BLOCK 202
BUF2: 0
XWD 201,BUF3+1
BLOCK 202
BUF3: 0
XWD 201,BUF1+1
BLOCK 202
AER1: MOVEI DEV1MS; ERROR ROUTINE FOR NOT AVAILABLE
JSR TXTOUT; DECTAPE
MOVEI T1,4
MOVEI DNAM
PUSHJ P,SIXOUT
MOVEI DEV2MS
JSR TXTOUT
JRST SETUP
NER: MOVEI NAM1MS
JSR TXTOUT
MOVEI T1,6
MOVEI DLK
PUSHJ P,SIXOUT
HLRZ DLK+1
JUMPE NEX1
MOVEI "."
IDPB TOB+1
MOVEI T1,3
MOVEI DLK+1
PUSHJ P,SIXOUT
NEX1: MOVEI NAM2MS
JSR TXTOUT
JRST SETUP
NAM1MS: ASCIZ /
FILE /
NAM2MS: ASCIZ / NOT FOUND
/
DECPNT: PUSHJ P,DECPNN ;SPACE COMES AFTER NUM IS TYPED.
MOVEI A,40
SOSGE TOB+2
OUTPUT TTY,0
IDPB A,TOB+1
POPJ P,
DECPNN: IDIVI A,12 ;PRINT DECIMAL INTEGER FROM A.
HRLM B,(P) ;SAVE LOW ORDER DIGIT.
SKIPE A ;DONE ?
PUSHJ P,DECPNN ;NO. RECUR FOR REST OF DIGITS.
HLRZ A,(P) ;YES. GET HIGH ORDER DIGIT.
ADDI A,"0" ;CONVERT TO ASCII.
SOSGE TOB+2 ;OUTPUT IT.
OUTPUT TTY,0
IDPB A,TOB+1
POPJ P, ;RETURN.
SIXOUT: TLO 440600 ; MAKE BYTE POINTER
LOOPTS: SOJL T1,[POPJ P,]
ILDB T,0
JUMPE T,[POPJ P,]
ADDI T,40
IDPB T,TOB+1
JRST LOOPTS
TXTOUT: 0
TLO 440700; ANOTHER POINTER
LPT1: ILDB T,0
JUMPE T,RETPT
SOSGE TOB+2
OUTPUT TTY,0
IDPB T,TOB+1
JRST LPT1
RETPT: OUTPUT TTY,0
JRST @TXTOUT
DEV1MS: ASCIZ /
DEVICE /
DEV2MS: ASCIZ / NOT AVAILABLE
/
IMS: ASCIZ /
* INPUT ? /
RDBUF: MOVEI [BYTE (7)15,12,52] ;ASCIZ / CR LF */
MOVSI A,'TTY'
CAME A,DNAM ;IS INPUT DEVICE A TTY ?
TLO FL,NOSTAR ;NO. SUPRESS THE *.
TLZN FL,NOSTAR ;PRINT IF NOSTAR NOT ON.
CALLI 3 ;YES. TYPE CR LF *.
;; NEXT 2 FOR SAVER
USETI DT,@RECCT# ;POSITION INPUT FILE TO RIGHT RECORD.
AOS RECCT ;ADD 1 TO RECORD CTR
INPUT DT,0 ;READ NEW INPUT BUFFER.
STATZ DT,20000 ;END OF FILE SEEN ?
JRST SETUP ;YES.
MOVEI 4 ;MAKE SURE 0 WORD TERMINATES IT.
ADD ICCNT ;CHAR. COUNT +4/5 IS WORD COUNT.
MOVEI A,5 ;BECAUSE WE DON'T WANT TO LOSE B.
IDIVM A ;SEE? NO RANDOM REMAINDER !!
ADD A,SCP ;ADD BASE ADDRESS.
IBP A ;BAGBITING SYSTEM.
SETZM (A) ;ZERO IT.
MOVE SCP
MOVEM ISCP# ;SAVE FOR ERROR PRINTOUT.
POPJ P,
SUBTTL ALGOL SCANNER -- 9/8/66 D. POOLE
;CALL IS PUSHJ P,-----. SCANS NEXT ATOMIC ELEMENT OF
; INPUT STRING, RETURNS ELEMENT IN ACCUM. 'A' AS FOLLOWS:
; UNDEFINED IDENTIFIER-- RETURNS 0.
; DECLARED IDENTIFIER--- 'A' CONTAINS RANDOM GOOD BITS FROM
; THE SYM. TBL. IN LEFT HALF, PTR. TO RGB WORD IN RT. HALF.
;RESERVED WORD OR SINGLE-CHARACTER OPERATOR--- 'A' CONTAINS
; THE RANDOM BITS WORD FROM EITHER THE RESERVED WORD TABLE
; OR THE CHAR. CONVERT TABLE, RESPECTIVELY.
BUCKNO←←1; SEE DFUNC BEFORE CHANGING !!!!
ACCUM: BLOCK 40 ;GOOD ENOUGH FOR NOW...
SCANNS: TLOA FL,NOSTAR ;SUPRESS PRINTING OF *.
SCANR: TLOA FL,400000 ;ENTRY WHEN EXPECTING OPERATOR OR
; RESERVED WORD.
SCANV: TLZ FL,400000 ;ENTRY WHEN EXPECTING VARIABLE.
SCAN:
SKIPE A,SNCHR# ;IF SNCHR IS NON-ZERO,
JRST SL1 ; IT IS THE NEXT CHAR. TO SCAN.
SL10: ILDB A,SCP ;GET NEXT CHAR.
SKIPN A,CTBL(A) ;SKIP LEADING BLANKS.
JRST SL10
JUMPL A,SL1A ;IF OPERATOR, WE'RE DONE.
TLNE A,SNUMF ;CHECK FOR PART OF A NUMBER.
JRST SNUM1
MOVE T2,[POINT 6,ACCUM,5] ;PREPARE TO SCAN AN
SETZB T,ACCUM ;IDENTIFIER.
MOVEM T,ACCUM+1
MOVEM A,FOONLY
SL2: IDPB A,T2 ;APPEND CHAR. TO IDENTIFIER.
ILDB A,SCP ;NEXT CHAR.
SKIPLE A,CTBL(A) ;CHECK FOR TERMINATOR.
AOJA T,SL2 ;INCREMENT COUNT AND LOOP.
TLNE A,SSPC2F ;DOES TERMINATING CHAR. REQUIRE
JRST SSPCB ;IMMEDIATE ATTENTION ?
MOVEM A,SNCHR ;NO, SAVE IT FOR NEXT TIME.
ADDI T,1
DPB T,[POINT 6,ACCUM,5] ;PUT COUNT IN FIRST CHAR.
HRRZS T2
SUBI T2,ACCUM
HRRZM T2,ACCWC#
MOVE A,ACCUM ;PREPARE TO SEARCH TABLES.
MOVE C,ACCUM+1
TLZE FL,400000 ;DO WE EXPECT AN OPERATOR ?
JRST SRSCH ;YES; SEARCH RES. WD. TBL. FIRST
SMSCH: MOVE T,A ;SEARCH MAIN SYM. TBL.
IDIVI T,BUCKNO ;DO HASH ON IDENT.
MOVMS T1 ;MAKE SURE IT'S POSITIVE.
MOVEM T1,CBNO# ;SAVE BUCKET NO.
HRRZ B,BUCTBL(T1) ;HEAD OF RIGHT BUCKET
; IN SYM. TBL.
SL5: CAMN A,1(B) ;COMPARE FIRST WORDS.
JRST SL4
SL6: HRRZ B,(B) ;GET NEXT ELEMENT OF
JRST SL5 ; THE LINKED LIST.
SL4: CAIN B,A-1 ;FIRST WORD WAS EQUAL...
JRST SNO ; WE ARE AT END OF BUCKET.
SKIPN T1,T2
JRST SFOUND ;ONLY 1 WORD; WE'RE DONE.
CAME C,3(B) ;COMPARE SECOND WORDS...
JRST SL6 ;NOPE.
SOJE T1,SFOUND ;ANY MORE WORDS ?
MOVE T3,[XWD B,4]; YES. PREPARE TO CHECK THEM.
SL7: MOVE D,ACCUM-2(T3)
CAME D,@T3
JRST SL6 ;NOT EQUAL.
SOJE T1,SFOUND ;MORE STILL ?
AOJA T3,SL7 ;YES; KEEP CHECKING.
SFOUND: MOVEI A,2(B) ;FOUND HIM; CALC. PTR. TO RGB WORD.
HLL A,(A) ;GET RANDOM GOOD BITS.
HRRZ B,A
SEXIT: CAIG T2,1 ;MORE THAN 2 WORDS OF NAME ?
POPJ P, ;NO.
SETZM ACCUM(T2) ;YES; ZERO OUT ALL THE WORDS OF
SOJA T2,SEXIT ; ACCUM THAT WE USED.
SNO: TLCN FL,400000 ;NOT IN MAIN TBL; HAVE WE ALREADY
JRST SRSCH ; SEARCHED RES. WORD TBL ?
SN1: MOVE A,FOONLY ;GARPBAZ !
TLNE A,FOOBIT
JRST FOOSCH
SCH1: SETZB A,B ;YES. RETURN 'UNDEFINED'.
POPJ P,
SL1: SETZM SNCHR ;RETURN FOR A SPECIAL CHAR.
SL1A: TLNN A,SSPCF+SSPC2F ;DOES IT NEED SPECIAL SERVICE ?
POPJ P, ;NO.
PUSHJ P,(A) ;YES. DISPATCH ON IT.
JRST SL10 ;CONTINUE SCANNING.
FOOSCH: LDB B,[POINT 6,ACCUM,17]
TRNE FL,SFOOBT ;ARE WE DEFINING A FUNCTION ?
JRST SCH1 ;YES. NO FOO-SYMBOLS ALLOWED.
CAIG B,31 ;IS IT A DIGIT?
CAIGE B,20
JRST SCH1 ;NO.
SUBI B,20 ; TO VALUE.
LDB C,[POINT 6,ACCUM,23]
JUMPE C,FSCH1
LDB D,[POINT 6,ACCUM,29]
JUMPN D,SCH1
IMULI B,12 ;MUL. TENS DIGIT BY 10.
CAIG C,31
CAIGE C,20
JRST SCH1
ADDI B,-20(C) ;ADD IN ONE'S DIGIT.
FSCH1: DPB B,[POINT 17,A,35] ;PUT NUMBER IN A.
POPJ P, ;RETURN FROM SCAN.
S.VT: ;HERE ON VERTICAL TAB.
S.FF: ;FORM FEED.
S.LF: ;LINE FEED
SENDL: TLZ FL,ERRFLG ;END OF LINE. CLEAR ERROR FLAG.
MOVEI A,1
ADD A,SCP ;GET PTR TO NEXT WORD.
SKIPN T,(A)
JRST S.EOB ;ZERO WORD MEANS END OF BUFFER.
TRNN T,1 ;IS IT A LINE NO. ?
POPJ P, ;NO; CONTINUE SCANNING.
TLZ A,770000 ;YES; ADVANCE PTR. PAST IT.
MOVEM A,SCP
POPJ P,
S.EOB: PUSHJ P,RDBUF ;REFILL BUFFER.
JRST SENDL
SSPCB: HALT
SSPCC: HALT
S.LT: ILDB A,SCP ;'<' SEEN; SKIP TO END OF LINE.
CAIE A,12 ;A LINE FEED ?
JRST S.LT ;NO.
JRST SENDL
SNUM1: MOVEI C,0 ;NUMBER SCANNER.
CAMN A,DOTV ;FIRST THING A DECIMAL PT.?
JRST SNUM6 ;YES
MOVNI T,100 ;NO DEC PT. YET.
SNUM2: IMULI C,12
ADDI C,-20(A) ;CONVERT NEW DIGIT TO VALUE AND ADD IN
AOSA T ;INCREMENT DEC. PLACE COUNT.
SNUM6: MOVEI T,0 ;START COUNTING DEC. PLACES.
ILDB A,SCP ;NEXT CHAR.
SKIPG A,CTBL(A) ;GET MAGIC BITS.
JRST SNUM7 ;IT'S A DELIMITER.
TLNE A,SDFLG ;IS IT A DIGIT ?
JRST SNUM2 ;YES.
CAMN A,DOTV ;A DEC. PT. ?
JRST SNUM6 ;YES.
JRST SNUMX1
SNUM7: TLNE A,SSPC2F ;DOES DELIM. REQUIRE INSTANT SERVICE ?
JRST SSPCC ;YES.
MOVEM A,SNCHR ;SAVE FOR NEXT TIME.
SFLTIT: IDIVI C,400000 ;FLOAT IT.
SKIPE C
TLC C,254000
TLC D,233000
FAD C,D
SKIPLE T
FDVR C,[10.0] ;DIVIDE BY 10 ENOUGH TO GET
SOJG T,.-1 ;DEC. PT. IN RIGHT PLACE.
SKIPA T,[XWD FLTFLG,0] ;GET FLOATING PT. FLAG.
SNFX: MOVSI T,FIXFLG
HLLZ A,T ;COPY FLAG TO A.
TRNN FL,SFOOBT
TLZE FL,SNUMF1
POPJ P,
;; NOW SEARCH NUMBER TABLE FOR THE NUMBER.
TDOA A,NUMBUC ;NUMBUC TO RT. HALF.
SNUM4: HRR A,-1(A) ;GET NEXT LINK.
CAME C,(A) ;IS IT EQUAL ?
JRST .-2 ;NO.
TRNN A,777760 ;ARE WE AT END OF TABLE ?
JRST SNUMNO ;YES.
TDNN T,-1(A) ;NO. DO TYPES MATCH ?
JRST SNUM4 ;NO.
POPJ P, ;YUP. WE'VE FOUND IT.
SNUMNO: TRNE FL,CSBRBT ;ARE WE INSIDE A FUNCTION DEFINITION ?
JRST SNUMX ;YES.
AOS B,JOBFF ;INSERT NEW NUMBER IN TABLE.
HRR A,B
EXCH B,NUMBUC ;UPDATE NUMBUC.
HRRM B,-1(A) ;PUT IN NEW LINK.
HLLM A,-1(A) ;PUT IN TYPE FLAG.
MOVEM C,(A) ;ALSO VALUE.
AOS T,JOBFF ;BUMP POINTER PAST VALUE.
HRLM T,JOBSA
POPJ P,
SNUMX: IOR T,VLOC ;WE WILL PUT NO. IN VARIABLES AREA.
PUSH P,T ;SAVE PTR. TO LOC.
MOVE A,C ;VALUE OF NO. TO A.
MOVEI B,0 ;NO RELOCATION.
PUSHJ P,EMVCDI ;EMIT TO VARIABLES BUFFER.
JRST POPAJ ;SEE EMINST.
; RESERVED WORD TABLE SEARCHER.
SRSCH: LDB B,[POINT 6,ACCUM,5] ;GET CHAR. COUNT.
CAIL B,3 ;NO 1-CHAR. RES. WDS.
CAILE B,13 ;ALSO NONE OF > 9 CHARS.
JRST SRNO
MOVE B,SRTBL1-2(B) ;GET RIGHT SECTION OF TBL.
CAME A,(B) ;COMPARE FIRST WORD.
SRS1: AOBJN B,.-1
JUMPGE B,SRNO ;ARE WE AT END OF SETCTION ?
CAME C,LRTBL(B) ;NO; COMPARE SECOND WORD.
JRST SRS1
MOVE A,2*LRTBL(B) ;THIS IS IT; GET GOOD BITS.
TLNE A,SSPCF ;DOES IT NEED OUR ATTENTION ?
JRST (A) ;YES.
JRST SEXIT ;NO.
SRNO: TLCN FL,400000 ;NOT A RES. WORD; HAVE WE ALREADY
JRST SMSCH ;SEARCHED MAIN SYM. TBL. ?
JRST SN1 ; YES; RETURN.
.COMME: MOVE A,SNCHR ;A COMMENT; SKIP TO NEXT ';'
SETZM SNCHR
.COMM1: CAMN A,SEMICV
JRST SCAN
TLNE A,SSPCF+SSPC2F ;SPECIAL TREATMENT ?
PUSHJ P,(A) ;YES.
ILDB A,SCP
MOVE A,CTBL(A)
JRST .COMM1
BUCTBL: REPEAT BUCKNO,<EXP TEMPSY> ;TABLE OF HEADS OF THE
;HASH-CODED BUCKETS IN SYM. TABLE.
NUMBUC: EXP C ;HEAD OF NUMBER TABLE
;THE CHARACTER CONVERSION TABLE -- GOOD BITS FOR EVERYONE !
; GET YOURS WHILE THEY LAST !
OPDEF ILG [XWD DF+SSPCF,SILCH]
CTBL: XWD DF+SSPCF,SENDL
REPEAT 10,<ILG>
0 ; HORIZONTAL TAB.
XWD DF+SSPCF,S.LF ;LINE FEED
XWD DF+SSPCF,S.VT ; VERTICAL TAB
XWD DF+SSPCF,S.FF ;FORM FEED
0 ;CARRIAGE RETURN.
REPEAT 14,<ILG>
XWD DF+SSPCF,SENDL ;↑Z.
REPEAT 5,<ILG>
0 ;SPACE
REPEAT 7,<ILG>
LPARV: XWD DF,1
RPARV: XWD DF,2
XWD DF+MULBIT,MULOP ; *
PLSV: XWD DF+ADDBIT,ADDOP ; +
COMMAV: XWD DF,COMMOP ; ,
MINV: XWD DF+ADDBIT,SUBOP ; -
DOTV: XWD SNUMF,"." ; .
XWD DF+MULBIT,DIVOP ; /
CTNUM: REPEAT 12,<XWD SDFLG+SNUMF,20+.-CTNUM> ; THE DIGITS.
COLONV: XWD DF,3 ; :
SEMICV: XWD DF,4 ; ;
XWD DF+SSPCF,S.LT ;<
;; XWD DF+RELBIT,EOP ; =
XWD DF,ASNOP ;← AND = DO THE SAME THING. 5/74
XWD DF+RELBIT,GOP ; >
REPEAT 2,<ILG>
CTLTR: REPEAT =5,<XWD 0,41+.-CTLTR> ;THE LETTERS.
41+.-CTLTR ;F
REPEAT =9,<41+.-CTLTR>
XWD FOOBIT,41+.-CTLTR+400000 ;P
REPEAT 4,<41+.-CTLTR>
XWD FOOBIT,41+.-CTLTR
REPEAT 5,<41+.-CTLTR>
LFTBRK: XWD DF,5 ; [
ILG
RGTBRK: XWD DF,6
UARV: XWD DF,EXPOP ; ↑
LARV: XWD DF,ASNOP ;← LEFT ARROW??
REPEAT 35,<ILG>
ALTV: XWD DF,. ;ALT MODE.
REPEAT 2,<ILG>
; END OF CONVERT TABLE.
DEFINE PUT1 (N,Y)
< FOR X IN (Y)
<Q←<SIXBIT /X/>
N*10000000000+(7777777777&(Q/100))
>>
DEFINE PUT2 (Y)
<FOR X IN (Y)
<SIXBIT /X/
>>
RTBL: ;THE RESERVED WORD TABLE.
RT3C: PUT1 (3,END) ;THE 3-LETTER SECTION.
RT4C: PUT1(4,<PLAY>)
RT5C: PUT1(5,<ARRAY>)
RT6C: PUT1 (6,FINIS) ;THE 6-LETTER SECTION.
RT7C: PUT1 (7,<COMME,COMPI>)
RT8C: PUT1 (10,<VARIA,FUNCT,EXTER>) ;VARIABLE
RT10C: PUT1 (12,INSTR) ;
LRTBL←←.-RTBL
RTBL2: 0 ;END
0 ;PLAY.
0
PUT2 (H)
PUT2 (<NT,LE>) ;COMMENT
PUT2 (<BLE,ION,NAL>)
PUT2 (UMENT) ;INSTRUMENT
RF←←DF+RFLG
RTBL3:
ENDV: XWD RF,.
PLAYV: XWD RF,.
ARRV: XWD RF+DECLBIT,DARR
FINV: XWD RF,.
COMV: XWD SSPCF,.COMME
COMPV: XWD RF,.
VARV: XWD RF+DECLBIT,DVRBL
FUNV: XWD RF+DECLBIT,DFUNC ;FUNCTION
EXTV: XWD RF+DECLBIT,EXTD
INSV: XWD RF+DECLBIT,CINS
SRTBL1: 0 ;2
XWD -1,RT3C
XWD -1,RT4C
XWD -1,RT5C
XWD -1,RT6C
XWD -2,RT7C
XWD -3,RT8C
0
XWD -1,RT10C
0
SRSFOO: JUMP 2*LRTBL(B)
;; MORE BITS AND PARAMETERS.
RELBIT←←0
;SIZES OF VARIOUS STACKS AND TABLES:
LOBUFS←←200
LUOTBL←←62
LPLIST←←100
LOSTK←←40
LPA←←62
LRQ←←=75 ;LENGTH OF RUN QUEUE.
;SPECIAL AC DEFINITIONS :
RA←16 ;AC FOR JSA LINKAGE AT RUNTIME.
DEFINE MAKOP1 (X)
<FOR @$ A IN (X)
<A$OP: HALT
>>
MAKOP1 <PW,COMM,L,E,G,EXP,ENDS,WHLS>
;; TEMPORARY AND DEBUGGING ROUTINES:
GO: MOVE P,[IOWD LPLIST,PLIST]
AOSE ONCEFG ;IS THIS FIRST TIME THROUGH ?
JRST GOA ;NO. LEAVE JOBFF AT CURRENT PLACE.
HRLZ 116 ;YES. GET BOTTOM OF SYM. TAB. FROM JOBSYM.
SUB 116 ;ADD LENGTH OF SYM. TAB.
HRLM JOBFF
GOA: HRR JOBFF
HRLM JOBSA
MOVEI FL,0
PUSHJ P,SETUP
GOB: MOVE P,[IOWD LPLIST,PLIST]
MOVE [JSR ERR1] ;SET UP FOR ERROR UUO.
MOVEM 41
MOVE JOBREL
MOVEM JOBSYM
JRST SCHOWN
ONCEFG: -1
DEFINE ERROR (M)
<XWD 1000,[ASCIZ /M/] >
UDIERR: ERROR (UNDEFINED IDENTIFIER)
SILCH: ERROR (ILLEGAL CHARACTER)
SNUMX1: ERROR(ILLEGAL CHAR. IN NUMBER)
FNDWV: HALT
;USEFUL F4 FUNCTIONS TO HAVE AROUND....
EXTERNAL SIN,COS,EXP,ALOG,SQRT
TEMPSY: EXP TMPS1Z
PUT1 5,OSCIL
XWD UGBIT,.+2
0
JSP RA,@OSCIL ;POINTER DID NOT RESET WITH '1,5,0,1' IN NEXT!!!!
BYTE (6)4,2,2,1,4,0,1;***** JULY 3,71 THIS ENDED '1,5,0,1' ****
TMPS1Z: TMPS1
PUT1 6,ZOSCI
XWD UGBIT,.+3
PUT2 (L)
0
JSP RA,@ZOSCIL
BYTE (6)4,2,2,1,5,0,1
;CHANGE LAST OF ABOVE TO .. 4,0,1 TO MAKE ZOSCIL NOT LIKE COSCIL
TMPS1: EXP TIMESC+1
PUT1 6,TIMES
XWD VRBLBT,TIMESC
PUT2 C
TIMESC: 1.0
EXP SRATE+1
PUT1 5,SRATE
XWD VRBLBT,SRATE
SRATE: 10000.0
EXP NCHNS+1
PUT1 5,NCHNS
XWD VRBLBT,NCHNS
NCHNS: 1
EXP LSBUF+1
PUT1 5,LSBUF
XWD VRBLBT,LSBUF
LSBUF: 1000
EXP TMPS2
PUT1 3,OUT
XWD UGBIT,.+2
0
JSA RA,@OUT
BYTE (6)1,2,0,0
TMPS2: EXP TMPS3
PUT1 4,OUT2
XWD UGBIT,.+2
0
JSA RA,@OUT2
BYTE (6)3,2,2,2,0,0
TMPS3: TMPS3A
PUT1 5,SPEED
XWD VRBLBT,SPEED
SPEED: 1
TMPS3A: TMPS11
PUT1 6,ZINTR
XWD UGBIT,.+3
PUT2 P
JSA RA,IINTRP
JSP RA,@ZINTRP
BYTE (6)5,2,2,5,1,4,0,T
TMPS11: TMNOSA
PUT1 6,VFMUL
XWD UGBIT,.+3
PUT2 T
0
JSP RA,@VFMULT
BYTE (6)3,2,2,1,0,T
; OSCIL IS NOW THE NOSCIL...JMG 7/14/73
; SOMEDAY, IF IT IS EVER USED, SOMEONE COULD CHANGE
; THE NAME OF NOSCA TO OSCA, ETC.
;TMPS12: TMNOSA
; PUT1 6,NOSCI
; XWD UGBIT,.+3
; PUT2 L
; 0
; JSP RA,@NOSCIL
; BYTE (6)4,2,2,1,4,0,1
TMNOSA: TMPS13
PUT1 5,NOSCA
XWD UGBIT,.+2
JSA RA,INOSCA
JSP RA,@NOSCA
BYTE (6)5,2,2,2,1,5,0,T
;TMPS13: TMPS14
; PUT1 10,DISKF
; XWD VRBLBT,DISKFL
; PUT2 LAG
;DISKFL: 0
TMPS13: TMPS24
PUT1 5,INTRP
XWD UGBIT,.+2
JSA RA,IINTRP
JSP RA,@INTRP
BYTE (6)5,2,2,5,1,4,0,T
TMPS24: TMPS14
PUT1 4,READ
XWD UGBIT,.+2
JSP RA,READI
JSP RA,@READ
BYTE (6)6,2,2,1,2,5,5,0,T
TMPS14: TMPS15
PUT1 4,REVX
XWD UGBIT,.+2
JSP RA,REVXI
JSP RA,@REVX
BYTE (6)20,2,2,2,2,2,2,2,2,2,4,4,4,4,4,1,4,0,T
TMPS15: .+3
PUT1 4,OUTA
XWD VRBLBT,OUTA
.+3
PUT1 4,OUTB
XWD VRBLBT,OUTB
.+3
PUT1 4,OUTC
XWD VRBLBT,OUTC
.+4 ;DOPLAY←1=WILL PLAY WHEN WRITING SMPLS ON DSK
PUT1 6,DOPLA
XWD VRBLBT,DOPLAY#
PUT2 Y
.+3
PUT1 4,OUTD
XWD VRBLBT,OUTD
.+4 ;RCDFLG←1 PUTS SAMPLES ON DSK UNDER 'MUSAA','MUSAB',ETC.
PUT1 6,RCDFL
XWD VRBLBT,RCDFLG#
PUT2 G
.+4
PUT1 6,BIGBI
XWD VRBLBT,BIGBIT#
PUT2 T
.+6
PUT1 5,VALUE
XWD UGBIT,.+2
0
JSP RA,@VALUE
BYTE (6)1,2,0,T
.+5
PUT1 4,RAND
XWD FUNBIT,.+1
PUSHJ P,RAND
BYTE (6)0,T
FRSTB+1
PUT1 =9,FIRST
XWD VRBLBT,FRSTB
PUT2 BAND
FRSTB: 0
.+5
PUT1 5,PRINT
XWD FUNBIT,.+1
JSA RA,FOOPRT
BYTE (6)1,2,0,0
.+3
PUT1 3,RDA
XWD RVBT∨VRBLBT,RDA
.+3
PUT1 3,RDB
XWD RVBT∨VRBLBT,RDB
.+3
PUT1 3,RDC
XWD RVBT∨VRBLBT,RDC
.+3
PUT1 3,RDD
XWD RVBT∨VRBLBT,RDD
FMPSA: EXP TMPS4 ;LINEN.
PUT1 5,LINEN
XWD UGBIT,.+2
JSA RA,LINEN1
JSP RA,@LINEN
; BYTE (6)13,4,4,4,2,2,2,2,1,4,4,4,0,1
BYTE (6)13,4,4,4,2,2,2,2,1,2,4,4,0,1
;NOW YOU MUST RESET PTR IN LINEN
TMPS4: EXP TMPS4A
;TMPS4: EXP TMPS5
PUT1 5,EXPEN
XWD UGBIT,.+2
0
JSP RA,@EXPEN
BYTE (6)4,2,2,1,4,0,1
TMPS4A: EXP TMPS5
PUT1 6,ZEXPE
XWD UGBIT,.+3
PUT2 N
0
JSP RA,@ZEXPEN
BYTE (6)4,2,2,1,4,0,1
TMPS5: EXP TMPS6
PUT1 (4,REV1) ;REV1
XWD UGBIT,.+2
JSP RA,REVI
JSP RA,@REV1
BYTE (6)6,2,2,2,1,5,4,0,1
TMPS6: EXP TMPS7
PUT1 4,REV2
XWD UGBIT,.+2
JSP RA,REVI
JSP RA,@REV2
BYTE (6)6,2,2,2,1,5,4,0,1
TMPS7: EXP TMPS8
PUT1 (7,REVIN) ;REVINIT.
XWD VRBLBT,REVINI
PUT2 IT
REVINI: 0
TMPS8: EXP TMPS9
PUT1 (5,RANDH)
XWD UGBIT,.+2
JSP RA,IRANDH
JSP RA,@RANDH
BYTE (6)4,2,2,4,4,0,1
TMPS9: EXP TMPS10
PUT1 (5,RANDI)
XWD UGBIT,.+2
JSP RA,IRANDI
JSP RA,@RANDI
BYTE (6)5,2,2,4,4,4,0,1
TMPS10: EXP A-1
PUT1 6,COSCI
XWD UGBIT,.+3
PUT2 L
0
; JSP RA,@NOSCIL
JSP RA,@OSCIL
BYTE (6)4,2,2,1,5,0,1
;; HERE ARE SOME WONDERFUL UNIT GENERATORS.
; THIS IS THE OLD OSCIL WHICH DOESN'T LIKE NEG. INCS.
;OSCIL: MOVE INSXR,3(RA)
; FIX INSXR,233000
; TRZE INSXR,777000
; JSP T1,OSCIL1
; MOVE T,@2(RA)
; FMPR T,@(RA)
; SKIPGE T1,@1(RA) ;OSCIL DOESN'T WANT NEG. INC.
; ERROR (NEGATIVE INC. TO OSCIL)
; FADM T1,3(RA)
; JRST 4(RA)
NOSCA: ADDI RA,1
;NOSCIL: MOVE INSXR,3(RA)
OSCIL: MOVE INSXR,3(RA)
;;*** CAUSE OF ROUNDOFF PROBS???? FAD INSXR,[0.5]
;; HRLZI T1,233000
;; UFA T1,INSXR
; THE ABOVE 2 INST'S REPLACE THE FIX FOR INDEXING
FIX INSXR,233000
TRZE INSXR,777000
JSP T1,OSCIL1
MOVE T,@2(RA)
FMPR T,@(RA)
MOVE T1,@1(RA)
FADM T1,3(RA)
JRST 4(RA)
OSCIL1: MOVSI (-512.0) ;WRAP AROUND THE POINTER.
JUMPGE INSXR,.+2
MOVNS 0 ;IF NEG. INC., WRAP AROUND OTHER WAY.
FADM 3(RA)
HRLI INSXR,0 ;TO ALLOW ZOSCIL=NOSCIL
JRST (T1)
OUT: 0
MOVE @(RA) ;PICK UP INPUT.
FADM OUTA ;ACCUMULATE INTO OUTPUT ARRAY.
POPJ P, ;RETURN FROM INSTRUMENT.
OUT2: 0
MOVE @(RA)
MOVE 1,0
FMP @1(RA)
FADM OUTA ;
FMP 1,@2(RA)
FADM 1,OUTB
POPJ P,
EXPEN: MOVE INSXR,@1(RA) ;GET INCREMENT.
FADB INSXR,3(RA) ;INCREMENT POINTER.
FIX INSXR,233000
;; HRLZI T1,233000
;; UFA T1,INSXR
; CAIL INSXR,777 ;IF GREATER THAN 512, STICK
TRZE INSXR,777000
EXPEN2: MOVEI INSXR,777 ;AT LAST ELEMENT OF ARRAY.
MOVE T,@2(RA) ;GET ARRAY ELEMENT.
FMPR T,@(RA) ;MULTIPLY BY AMPLITUDE.
JRST 4(RA) ;RETURN.
VFM2: FSBR INSXR,[512.0] ;YOU MUST NOW SET PTR FOR VFMULT!
MOVEM INSXR,@VFMULT
VFMULT: MOVE INSXR,@1(RA) ;GET POINTER INPUT.
CAML INSXR,[512.0]
JRST VFM2
FIX INSXR,233000
;; HRLZI T1,233000
;; UFA T1,INSXR
MOVE T,@2(RA) ;GET INDICATED ELEMENT OF ARRAY.
FMPR T,@(RA) ;MULT. BY AMPLITUDE.
JRST 3(RA)
INOSCA: 0
MOVE T,(RA)
MOVE T1,@-6(T)
MOVEM T1,-2(T)
JRA RA,1(RA)
INTRP: ADDI RA,1
MOVE INSXR,3(RA)
FIX INSXR,233000
;; HRLZI T1,233000
;; UFA T1,INSXR
TRZE INSXR,777000
JSP T1,OSCIL1
MOVE T,@2(RA)
FMPR T,@(RA)
FADR T,@-1(RA)
MOVE T1,1(RA)
FADM T1,3(RA)
JRST 4(RA)
IINTRP: 0
MOVE T,(RA)
MOVE T1,@-5(T)
FSBR T1,@-6(T)
MOVEM T1,@-5(T)
MOVSI T1,(512.0)
FDVR T1,SRATE
FDVR T1,PBASE+2
MOVEM T1,-4(T)
JRA RA,1(RA)
ZEXPEN: SKIPGE INSXR,3(RA) ;ZEXPEN WORKS LIKE ZOSCIL AND EXPEN!
JRST[ ERROR (NEGATIVE INC. TO ZEXPEN)
JSP T1,OSCIL1 ;DO WRAPAROUND ANYWAY
JRST .+1] ;LET THE LOSER CONTINUE
; IT TAKES THESE 4 INST'S TO DO A GOOD FIX FOR FURTHER USE
FIX INSXR,233000
;; HRLZI T1,233000
;; UFA T1,INSXR
;; JUMPE INSXR,.+2
;; TLC INSXR,233000
CAIL INSXR,777 ;IF GREATER THAN 511, STICK
JRST EXPEN2 ;AT LAST ELEMENT (WE WON'T NEED TO INTERPOLATE)
MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
move insxr ;SAVE INDEX
move t1,t ;COPY FIRST ELEMENT
addi insxr,1 ;NO, INCREMENT INDEX
fsbr t1,@2(ra) ;GET DWFFERENCE IN VALUE I
fsc 233 ;(FLOAT THE INDEX)
fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
FMPR T,@(RA) ;SCALED BY AMPLITUDE
MOVE T1,@1(RA) ;UPDATE SUM OF INCREMENTS
FADM T1,3(RA)
JRST 4(RA)
ZINTRP: ADDI RA,1 ;AN INTERPOLATING INTRP!
MOVE INSXR,3(RA)
FIX INSXR,233000
;; HRLZI T1,233000
;; UFA T1,INSXR
;; JUMPE INSXR,.+2
;; TLC INSXR,233000
TRZE INSXR,777000 ;DID WE RUN OVER?
JSP T1,OSCIL1 ;YES, DO WRAPAROUND (BUT IT REALLY SHOULDN'T!)
MOVE T,@2(RA) ;PICK UP FIRST ELEMENT
move insxr ;SAVE INDEX
move t1,t ;COPY FIRST ELEMENT
cain insxr,777 ;ARE WE AT THE LAST ELEMENT
tdza insxr,insxr ;YES, SET INDEX TO ZERO AND SKIP
addi insxr,1 ;NO, INCREMENT INDEX
fsbr t1,@2(ra) ;GET DIFFERENCE IN VALUE I
fsc 233 ;(FLOAT THE INDEX)
fsb 3(ra) ;GET DIFFERENCE IN INDEX INTO 0
fmpr t1,0 ;THE PRODUCT OF THE ABOVE TWO DIFFERENCES
fadr t,t1 ;IS ADDED TO THE FIRST ELEMENT
MOVE @(RA) ;GET SECOND VALUE
FSBR @-1(RA) ;SUBTRACT THE FIRST
FMPR T,0 ;MULIPLY BY DIFFENCE BETWEEN TWO VALUES
FADR T,@-1(RA) ;AND ADD TO THE FIRST VALUE
MOVE T1,1(RA) ;UPDATE SUM OF INCREMENTS
FADM T1,3(RA)
JRST 4(RA)
READ: AOS INSXR,4(RA)
CAML INSXR,5(RA)
JRST READ1
MOVEI T,0
LCS2: MOVE @2(RA)
MOVEM RDA(T)
ADDI T,1
CAML T,3(RA)
JRST 7(RA)
AOS INSXR,4(RA)
JRST LCS2
READ1: MOVE 2(RA)
MOVEM LCS+3
SUBI 1
HRRZM LCS+4
LCS: JSA 16,READIN
0
0
0
0
[-1]
SETZB INSXR,4(RA)
JRST READ+3
READI: MOVE T,(RA)
MOVE T2,@-4(T)
FIX T2,233000
;******↑↑↑↑↑↑ OK FOR EXPORT ????? 5/74
MOVEM T2,-4(T)
MOVE T2,-7(T)
MOVEM T2,LCS1+1
MOVE T2,-6(T)
MOVEM T2,LCS1+2
MOVE T1,-5(T)
MOVE T2, -1(T1)
MOVEM T2,-2(T)
SETOM -3(T)
MOVEM T1,LCS1+3
LCS1: JSA RA,READIN
0
0
0
T2
[0]
JRST 1(RA)
ZOSCIL: MOVE INSXR,3(RA) ;ZOSCIL WORKS LIKE COSCIL AND NOSCIL!
FIX INSXR,233000
;; HRLZI T1,233000
;; UFA T1,INSXR
;; JUMPE INSXR,.+2
;; TLC INSXR,233000
TRZE INSXR,777000
JSP T1,OSCIL1
MOVE T,@2(RA)
move insxr
move t1,t
cain insxr,777
tdza insxr,insxr
addi insxr,1
fsbr t1,@2(ra)
fsc 233
fsb 3(ra)
fmpr t1,0
fadr t,t1
FMPR T,@(RA)
MOVE T1,@1(RA)
FADM T1,3(RA)
JRST 4(RA)
;; REVERBERATION UNIT GENERATORS.
; REV1 IS THE SIMPLE FED-BACK DELAY LOOP, OR 'COMB FILTER'.
REV1: AOS INSXR,4(RA) ;INCREMENT OUTPUT PTR.
CAML INSXR,5(RA) ;IS IT TIME TO WRAP AROUND ?
SETZB INSXR,4(RA) ;YES.
MOVE 1,@3(RA) ;GET OUTPUT OF DELAY LINE.
MOVE 2,1 ;LEAVE IN 1 AS FINAL OUTPUT.
FMPR 2,@2(RA) ;MULTIPLY BY FEEDBACK GAIN.
;REVA: MOVE @1(RA) ;GET DELAY TIME, T.
; FIX 233000
; ADD INSXR,0 ;MOVE PTR. AROUND TO INPUT END.
; CAML INSXR,5(RA) ;PROBABLY HAVE TO WRAP AROUND..
; SUB INSXR,5(RA) ;YUP. SUBTRACT LENGTH OF DELAY ARRAY.
; THE ABOVE 5 INSTRUCTIONS ALLOW A DYNAMICALLY CONTROLLED
; DELAY TIME IN REVERB. TO INSTITUTE, CHANGE THE LOC. OF
; 'REVA:' BACK TO ABOVE AND DE-COMMENT. THE PRESENT REVERB
; ASSUMES THAT THE ARRAY LENGTH IS THE DELAY, SO THE ARGU-
; MENT IN THE UG IS IGNORED... JMG 7/14/73
REVA: FADR 2,@(RA) ;ADD IN THE INPUT SAMPLE.
JFCL 1,[SETZB 2,1 ;FLOAT. UNDER FLOW
SETOM FXUFLG#
JRST .+1] ;THESE WERE ON JC,MUS. WHY???
MOVEM 2,@3(RA) ;PLACE IN INPUT OF DELAY LINE.
JRST 6(RA) ;RETURN.
;REV2 IS THE ALL-PASS REVERBERATOR.
REV2: AOS INSXR,4(RA) ;CALC. PTR. AS IN REV1.
CAML INSXR,5(RA)
SETZB INSXR,4(RA)
;; MOVN 1,@3(RA) ;GET NEGATIVE OF OUTPUT OF DELAY.
;; MOVN 0,@2(RA) ;ALSO NEGATIVE OF GAIN, G.
;; FMPR 1,0 ;FORM GAIN*OUTPUT
;; MOVE 2,1 ;(NOTE THIS IS POSITIVE).
;; FMPR 1,0 ;FORM -G↑2 * OUTPUT.
;; FADR 1,@3(RA) ;(1-G↑2) * OUTPUT.
;; FMPR 0,@(RA) ;FORM -G * INPUT.
;; FADR 1,0 ;FINAL OUTPUT IS -G*IN +(1-G↑2)*OUT.
;; JRST REVA ;FROM HERE ON, SAME AS REV1.
MOVE 2,@2(RA) ;GET GAIN, G
FMPR 2,@(RA) ;MULTIPLY BY INPUT
FADR 2,@3(RA) ;ADD IN OUTPUT OF DELAY
MOVN 1,2 ;TAKE -(OUTPUT+G+IN)
FMPR 1,@2(RA) ;SCALE BY GAIN
FADR 1,@(RA) ;ADD INPUT
JFCL 1,[SETZB 2,1 ;FLOATING UNDERFLOW
SETOM FXUFLG#
JRST .+1]
MOVEM 1,@3(RA) ;NEW DELAY INPUT
JRST 6(RA) ;RETURN WITH ANSWER IN 2
; NEW REV. 1 LESS MULT. A.MOORER, 5/74
; THIS IS THE I-TIME CODE FOR REV1 AND REV2.
REVI: HRRZ T1,(RA) ;GET PTR. TO END OF REV PARAMS.
MOVNI INSXR,1 ;INSXR←-1
HRRZ @-4(T1) ;GET -1ST ELEMENT OF ARRAY (THE LENGTH)
MOVEM -2(T1) ;PLACE IN THE SECOND DUMMY PARAM.
SKIPN REVINI ;SHOULD WE INIT. THE DELAY ARRAY ?
JRST 1(RA) ;NO.
SETZM -3(T1) ;YES. FIRST CLEAR THE POINTER LOC.
HRRZ T,-4(T1) ;GET PTR. TO ARRAY.
REVI2: ADDI -1(T) ; 0 NOW POINTS TO TOP OF ARRAY.
HRL T,T
SETZM (T) ;CLEAR FIRST ELEMENT OF ARRAY.
ADDI T,1 ;FORM BLT POINTER.
BLT T,@0 ;CLEAR REST OF ARRAY.
JRST 1(RA)
;; MORE GENERATORS, SPECIFICALLY LINEN (THE INFAMOUS) AND VALUE
LINEN: MOVE INSXR,11(RA) ;GET INCREMENT.
; FADB INSXR,10(RA) ;ADD TO POINTER.
FADB INSXR,@10(RA) ;NOW YOU MUST RESET PTR
LINEN4: CAML INSXR,12(RA) ;ARE WE PAST END OF SECTION ?
JRST LINEN2 ;YES.
FIX INSXR,233000
MOVE T,@3(RA) ;AMPLITUDE.
FMPR T,@7(RA) ;MULT. BY ARRAY ELEMENT.
JRST 13(RA) ;RETURN.
; GET HERE WHEN WE ARE ABOUT TO CHANGE TO A NEW SECTION
LINEN2: MOVE T,12(RA) ;PICK UP CURRENT LIMIT.
FIX T,242000
CAIL T,3 ;END OF ARRAY ?
JRST LINEN3 ;YES.
HRLI T,RA ;PREPARE FOR INDEXING...
MOVE @T ;PICK UP NEXT INCREMENT.
MOVEM 11(RA) ;PUT AWAY.
MOVSI (128.0)
FADM 12(RA) ;INCREMENT LIMIT TO NEXT VALUE.
JRST LINEN4
; JAM 7/24/75
; WE GET HERE WHEN THE POINTER RUNS OFF THE END OF THE TABLE
; RETURN ZEROS FROM HERE ON.
LINEN3: SETZ T, ; CLEAR OUTPUT SAMPLE
JRST 13(RA) ; RETURN
IFN 0,< ; JAM 7/24/75
; THIS CODE REINITIALIZES THE POINTER TO THE BEGINNING
; OF THE ARRAY AFTER IT RUNS OFF. WE DECIDED THAT DUE
; TO ROUNDOFF ERROR (OR WHATEVER), IT SEEMED BEST TO
; SET SUBSEQUENT SAMPLES TO ZERO RATHER THAN WRAP AROUND.
LINEN3: MOVEI 14(RA) ;FAKE UP A PARAMETER FOR LINEN1.
MOVEM .+2
JSA RA,LINEN1 ;RE-INITIALIZE THE GENERATOR.
0 ;
; SETZM 10(RA) ;RESET PTR.
SETZM @10(RA) ;NOW YOU MUST RESET PTR
SETZM 11(RA) ;AND INCREMENT.
SETZM 12(RA) ;...AND LIMIT.
JRST LINEN
> ; MATCHES IFN 0 ABOVE
LINEN1: 0 ;THE INITIALIZING CODE FOR LINEN.
MOVE T2,(RA) ;GET POINTER TO END OF PARAMETERS.
MOVE T1,TIMESC ;CALC. 128*(BEATS/SAMPLE)
FDVR T1,SRATE
FSC T1,7
MOVE T,@-10(T2) ;GET RISE TIME IN BEATS.
FDVRM T1,T ;INCREMENT←T1/TIME (=128/(TIME IN SAMPS))
MOVEM T,-14(T2) ;PLACE IN PARAMETER 0.
MOVE T,@-6(T2) ;DURATION OF NOTE IN BEATS...
FSBR T,@-7(T2) ;...MINUS FALL TIME..
FSBR T,@-10(T2) ;...MINUS RISE TIME.
FDVRM T1,T ;CHANGE TO INCREMENT.
MOVEM T,-13(T2) ;PLACE IN PARAMETER 1.
FDVR T1,@-7(T2) ;INCREMENT FOR FALL TIME.
MOVEM T1,-12(T2) ;PLACE IN PARAMETER 2.
JRA RA,1(RA)
VALUE: MOVE T,@(RA) ;DUMMY UNIT GENERATOR... OUTPUT IS
JRST 1(RA) ;SAME AS ITS PARAMETER.
;; RANDOM NUMBER GENERATORS.
RANDH: MOVE @1(RA) ;GET INCREMENT.
FADB 2(RA) ;INCREMENT THE 'POINTER'.
CAML [512.0] ;OVER 512 ?
JRST RNDH2 ;YES. GO GET NEW RANDOM NUMBER.
MOVE T,@(RA) ;NO. GET INPUT ...
FMPR T,3(RA) ;... AND MULT. BY CURRENT RANDOM NO.
JRST 4(RA) ;RETURN.
RNDH2: MOVSI (-512.0) ;CAUSE 'POINTER' TO 'WRAP AROUND'.
FADM 2(RA)
PUSHJ P,RAND ;GET NEW RANDOM NO.
MOVEM T,3(RA) ;MAKE IT THE CURRENT NO.
FMPR T,@(RA) ;MULT. BY INPUT.
JRST 4(RA) ;RETURN.
IRANDI: ;I-TIME CODE FOR RANDI AND RANDH.
IRANDH: PUSHJ P,RAND ;INIT. RANDH.
MOVE T2,(RA) ;GET PTR. TO LAST PARAM..
MOVEM T,-2(T2) ;PUT INITIAL RAND. NO. IN.
JRST 1(RA)
RANDI: MOVE T,2(RA) ;GET CURRENT DELTA..
FADRB T,4(RA) ;ADD TO LAST OUTPUT VALUE...
SOSG 3(RA) ;DECREMENT STEP COUNTER ...
JRST RNDI2 ;IT'S 0, SO GET NEW RANDOM NO.
FMPR T,@(RA) ;NO. MULT BY INPUT.
JRST 5(RA) ;RETURN.
RNDI2: PUSHJ P,RAND ;GET NEXT RANDOM NO.
FSBR T,4(RA) ;FORM DELTA (=NEW - OLD)
MOVSI T1,(512.0)
FDVR T1,@1(RA) ;NO. OF STEPS = 512/(FREQ. INPUT)
FDVR T,T1 ;CHANGE PER STEP =DELTA/NO. OF STEPS
MOVEM T,2(RA) ;STORE CHANGE PER STEP.
FIX T1,233000
;**********↑↑↑↑↑↑↑
MOVEM T1,3(RA) ;PUT IT AWAY.
JRST RANDI ;NOW GO GENERATE FIRST STEP.
RAND: MOVE T,RNDNO1 ;GENERATE A RANDOM NO.
ADD T,RNDNO2
EXCH T,RNDNO2
MOVEM T,RNDNO1
ASH T,-10 ;SMEAR SIGN INTO EXPONENT FIELD..
FSC T,200 ;... AND FLOAT IT IN RANGE -1 TO 1.
POPJ P,
RNDNO1: 756132257563
RNDNO2: 756132257565
PLIST: BLOCK LPLIST
OSTK: BLOCK LOSTK
RQ1: BLOCK LRQ ;THE RUN QUEUE, CLOUMN ONE.
RQ2: BLOCK LRQ ;COLUMN TWO.
PATCH: BLOCK 100
IARR1: ;; HERE BEGINS AN AREA WHICH IS ZEROED DURING
; INITIALIZATION OF EACH COMPILATION.
UOTBL: BLOCK LUOTBL
ACS:
RACS: BLOCK 20
IACS: BLOCK 20
UOPTR: -1
IARR2:
PBASE: BLOCK LPA
OUTA: 0 ;CHANNEL A OUTPUT SAMPLE ACCUMULATED HERE.
OUTB: 0 ;CHANNEL B.
OUTC: 0 ;CHANNEL C.
OUTD: 0 ;CHANNEL D.
RDA: 0
RDB: 0
RDC: 0
RDD: 0
IARR3:
VLOC: 0
ILOC: 0
RLOC: 0
DSKMAX: =76*2000*17
;; THIS IS THE MULTIPLE-FEEDBACK REVERBERATOR.
;; ITS DELAY TIMES MUST NOT BE R-TIME VARIABLES.
REVX: SOSGE INSXR,15(RA) ; ADVANCE PTR. TO 4TH TAP.
JSP T1,REVX1 ;TIME TO WRAP AROUND....
MOVE T,@16(RA) ;GET DELAY ARRAY OUTPUT FROM 4TH TAP..
FMP T,@10(RA) ;MULT. BY GAIN NO. 4
SOSGE INSXR,14(RA) ;NOW PTR. TO 3RD TAP.
JSP T1,REVX1
MOVE @16(RA) ;... 3RD TAP DELAY OUTPUT...
FMP @6(RA) ;...3RD GAIN...
FAD T,0 ;ACCUMULATE SUM IN T.
SOSGE INSXR,13(RA) ;2ND TAP PTR.
JSP T1,REVX1 ;THIS COULD GET BORING.
MOVE @16(RA)
FMP @4(RA) ;GAIN 2.
FAD T,0
SOSGE INSXR,12(RA) ;ONE MORE CHORUS.
JSP T1,REVX1
MOVE @16(RA)
FMP @2(RA) ;GAIN 1.
FADB T,0 ;T NOW HAS FINAL OUTPUT(=SUM OF
; TAPS * GAINS).
FAD @(RA) ;ADD OUTPUT TO INPUT ..
SOSGE INSXR,11(RA) ;.. GET PTR. TO INPUT OF DELAY..
JSP T1,REVX1
MOVEM @16(RA) ;AND PUT IT THERE.
JRST 20(RA) ;WOULD YOU BELIEVE 20 PARAMETERS ??!
REVX1: ADD INSXR,17(RA) ;A PTR. HAS UNDERFLOWED; ADD
MOVEM INSXR,@-2(T1) ; LENGTH OF ARRAY TO IT TO WRAP
JRST (T1) ;IT AROUND (AND STORE UPDATED VERSION).
REVXI: MOVE T1,(RA) ;INITIALIZING FOR REVX.. GET PTR. TO PARAMMS.
MOVNI INSXR,1
MOVE @-3(T1) ;GET -1ST ELEMENT OF ARRAY (= ITS LENGTH).
MOVEM -2(T1) ;STORE IN LAST DUMMY PARAM.
SKIPE REVINI ;IF WE ARE INITIALIZING REVERBERATORS,
SETZM -10(T1) ;RESET INPUT PTR. OF DELAY TO BOTTOM OF ARRAY.
MOVSI T,-4 ;NOW WE SET UP THE FOUR DELAY OUTPUT TAP
HRRI T,-7(T1) ;PTRS. THE RIGHT DISTANCE BEHIND THE INPUT PTR.
MOVEI T2,-20(T1) ;
REVXI2: MOVE @(T2) ;PICK UP DELAY TIME (IN SAMPLES).
FIX 233000
;**********↑↑↑↑↑↑↑↑
ADD -10(T1) ;ADD TO INPUT PTR. POSITION.
CAML -2(T1) ;WRAP AROUND ?
SUB -2(T1) ;YES. SUB. LENGTH OF ARRAY.
MOVEM (T) ;PLACE PTR. IN RIGHT DUMMY PARAM.
ADDI T2,2 ;INC. T2 TO POINT AT NEXT DELAY TIME PARAM.
AOBJN T,REVXI2 ;LOOP TO GET ALL 4 DELAY TAPS.
SKIPN REVINIT ;ARE WE INITIALIZING REVERBERATORS ?
JRST 1(RA) ;NO. RETURN.
MOVE -2(T1) ;YES GET LENGTH OF ARRAY.
HRRZ T,-3(T1) ;GET BASE OF ARRAY.
JRST REVI2 ;GO ZERO ARRAY (SEE REV1 AND REV2 PAGE).
; ***** COMPX BEGINS HERE **** ROUTINES TO EMIT CODE AND STUFF TO OUTPUT BUFFERS.
EMDV: SETZB A,B ;EMIT A DUMMY VARIABLE (TO RESERVE
; SPACE IN THE VARIABLES AREA).
EMVCDI: AOS VLOC
EMVCD: MOVEI T1,2 ;EMIT TO VARIABLE BUFFER.
JRST ECD
EMIABS: TDZA B,B ;EMIT TO I-TIME BUF. , NO RELOC.
EMCDI: AOSA RLOC ;SKIP INSTRUCTIONS WIN BIG.
EMICDI: AOSA ILOC ; SEE THE HAPPY INTERLEAVED CODE !
EMCD: TDZA T1,T1 ;EMIT TO RUNTIME BUFFER.
EMICD: MOVEI T1,1 ;EMIT TO INITIALIZE TIME BUFFER.
ECD:
IDPB A,EMPTR(T1) ;EMIT THE WORD.
IDPB B,RELPTR(T1) ;ALSO ITS RELOCATION BITS.
AOSGE BUFCNT(T1) ;IS BUFFER FULL ?
POPJ P, ;NO. RETURN.
GBUF: ; BUFFER IS FULL; GET A NEW ONE.
MOVNI T,LOBUFS ;LENGTH OF A BUFFER.
PUSHJ P,GFS ;GET SOME FREE STORAGE(WHILE IT LASTS!)
HRLI T,400 ;MAKE BYTE PTR.
MOVEM T,RELPTR(T1) ;PTR. FOR RELOCATION BITS.
MOVEI T2,LOBUFS/12+2(T) ;LEAVE ROOM FOR REL. BITS
HRRM T2,EMPTR(T1) ;DATA PTR.
HRRZM T,@OBPTR(T1) ;FIX UP FORWARD LINKS.
HRRZM T,OBPTR(T1)
SETZM @OBPTR(T1)
MOVNI LOBUFS-LOBUFS/12-3
MOVEM BUFCNT(T1) ;SET UP WORD COUNT.
POPJ P,
EMPTR: POINT 36,0,35 ;DATA OUTPUT POINTERS.
EMIPTR: POINT 36,0,35
EMVPTR: POINT 36,0,35
RELPTR: POINT 4,0 ;RELOC. BITS PTRS.
RELIPT: POINT 4,0
RELVPT: POINT 4,0
OBPTR: BLOCK 3 ;PTR. TO FIRST WORD OF CURRENT BUFFER FOR
; USE IN FIXING UP FORWARD LINKS.
BUFCNT: BLOCK 3 ;WORD COUNTS FOR BUFFERS.
FCBUF: 0 ;PTR. TO FIRST BUFFER IN EACH CHAIN.
FICBUF: 0
FVCBUF: 0
GFS: ADD T,JOBSYM ;DECREMENT BOTTOM OF FREE STORAGE.
HRRZ JOBFF
CAIL (T) ;ROOM LEFT ?
ERROR (STORAGE FULL) ;NO.
MOVEM T,JOBSYM
POPJ P,
;THIS HERE IS THE COMPILER !
; RECURSIVE EXPRESSION ANALYZER.
SEXPR: PUSHJ P,SCAN
EXPR: PUSHJ P,TERM ;<EXPR> = <TERM> ! <TERM><ADDOP><EXPR>
EXPR1: TLNE A,DF ;A DELIMITER NEXT ?
TLNN A,ADDBIT ;YES. AN ADD OR SUBTRACT OP. ?
POPJ P, ;NO.
PUSH P,A ;YES. LOOK FOR ANOTHER TERM.
PUSHJ P,STERM ;THIS IS ITERATIVE INSTEAD OF
; RECURSIVE IN ORDER TO PROCESS FROM LEFT TO
EXCH A,(P) ; RIGHT.
PUSHJ P,(A) ;CALL APPROPRIATE GENERATOR.
POP P,A
JRST EXPR1
STERM: PUSHJ P,SCANV
TERM: PUSHJ P,FACTOR ;<TERM>=<FACTOR>!<FACTOR><MULOP><FACT.>
TERM1: TLNE A,DF ;A DELIMITER NEXT ?
TLNN A,MULBIT ;YES. A MULTIPLY OR DIVIDE OP ?
POPJ P, ;NO.
PUSH P,A
PUSHJ P,SFACTOR
EXCH A,(P)
PUSHJ P,(A)
POP P,A
JRST TERM1
SFACTOR:PUSHJ P,SCANV
FACTOR: JRST PRIMARY ;GOOD ENOUGH FOR NOW ...
SPRIM: PUSHJ P,SCAN
PRIMARY:
JUMPE A,UDIERR ;STILL UNDEFINED ?
TLNN A,DF ;IS IT A SPECIAL CHAR. ?
JRST PRIM3 ;NO.
PRIM2: CAMN A,MINV ;UNARY MINUS ?
JRST PRUMIN ;YES.
CAME A,LPARV ;NO. IT BETTER BE A (.
ERROR (ILLEGAL PRIMARY.)
PUSHJ P,SEXPR ;SCAN AN EXPRESSION.
CAME A,RPARV ;LOOK FOR MATCHING PAREN.
ERROR (MISSING RIGHT PAREN.)
JRST SCAN ;SCAN AND RETURN.
PRUMIN: PUSHJ P,SPRIM ;UNARY MINUS; SCAN A PRIMARY.
PUSH P,A
PUSHJ P,UMGEN ;CALL GENERATOR.
JRST POPAJ ;RESTORE A AND RETURN.
PRIM3: TLNN A,FUNBIT ;THE NAME OF A FUNCTION ?
JRST SVRBL ;NO.
PRFUN: PUSHJ P,FUNCAL ;COMPILE THE FUNCTION CALL.
PUSHJ P,MRKAC0 ;MARK AC0 FULL (VALUE OF FUNCTION).
JRST SCAN ;RETURN.
SVRBL: TLNN A,VRBLBT!SWVBT!NUMFLG!FOOBIT ;SHOULD BE A VARIABLE,ARRAY NAME,NUMBER OR FOO SYM.
ERROR (ILLEGAL PRIMARY)
TLNE A,VRBLBT!NUMFLG!FOOBIT ;IS IT AN ARRAY NAME ?
JRST SVRBL2 ;NO.
HRR A,(A) ;YES. GET R. HALF OF GOOD BITS.
SUBI A,2 ;MAKE IT POINT TO ARRAY[-2].
SVRBL2: PUSH OSP,A ;MAY BE AN ASN. STMT....
TLNE A,NUMFLG+SWVBT ;IF IT IS A NUMBER, IT CAN'T BE
JRST SCAN ;LEFT PART OF ASN. STMT.
SVRBL1: PUSHJ P,SCAN ;GET LEFT ARROW,IF ANY.
CAME A,LARV ;IT IS ONE, ISN'T IT ?
LAROW: POPJ P, ;NOPE. JUST A GARDEN VARIETY VARIABLE.
PUSHJ P,ASTMT1 ;YES. COMPILE IT.
PUSHJ P,MRKAC ;SINCE ITS A PRIMARY, REMEMBER ITS
JRST POPAJ ;VALUE, THEN RETURN.
ASTMT1: ;; COMPILE ASSIGNMENT STMT...
PUSHJ P,SEXPR ;COMPILE RIGHT PART OF STMT.
EXCH A,(P) ;SAVE 'A' UNDERNEATH RETURN ADR.
PUSH P,A
JRST ASNGEN ;GENERATE THE STORE.
; PROCESS A FUNCTION CALL.
FUNCAL: PUSH P,RLOC ;SAVE R-TIME CODE LOC. CTR.
HRRZ B,(A) ;GET PTR. TO PARAMETER DESCRIPTORS.
PUSH P,B ;PTR. TO SYMTABLE ENTRY.
PUSH OSP,(B) ;PLACE CALLING INSTR. ON OPND. STK.
PUSH P,[POINT 6,0,35] ;MAKE A PTR. TO THE BYTES
HRRM B,(P) ; OF THE PARAMETER DESRIPTION.
ILDB T,(P) ;GET PARAMTER COUNT.
PUSH P,T
JUMPE T,FNOPR ;IF NO PARAMS., CALL GENERATOR.
PUSHJ P,SCAN ;SWALLOW LEFT PAREN.
CAME A,LPARV ;I HATE PEOPLE WHO DO THIS.
ERROR (MISSING LEFT PAREN.)
PUSHJ P,SCAN ;SCAN FIRST PARAM.
FUNC4: PUSH P,A
FUNC1: ILDB T,-2(P) ;GET NEXT PARAM. DESCRIPTOR.
CAIN T,FDPARB ;IS IT A DUMMY PARAM. ?
JRST FDPAR ;YES.
CAIN T,FDPARC ;OR A TYPE 2 DUMMY ?
JRST FDPAR2 ;YES.
POP P,A ;NO.
JUMPE T,FLPAR ;IF =0,NO MORE PARAMS.
CAME A,RPARV ;NO PARENTHESES OR COMMAS HERE, PLEASE.
CAMN A,COMMAV
ERROR (MISSING PARAMETER)
CAIN T,FAOPAR ;MUST THIS PARAM. BE AN ARRAY NAME ?
JRST FAPAR ;YES.
PUSHJ P,EXPR ;NO, LET IT BE AN EXPRESSION.
FUNC2: CAMN A,COMMAV ;IS IT A COMMA ?
FUNC3: PUSHJ P,SCAN ;YES, ALTHOUGH WE DONT REALLY CARE.
JRST FUNC4
FLPAR: CAME A,RPARV ;LAST PARAM. IS FOLLOWED BY ).
ERROR (MISSING RIGHT PAREN.) ; ... OR ELSE.
FNOPR: PUSHJ P,GFUNC ;CALL GENERATORS.
ILDB A,-1(P) ;GET NO. OF AC CONTAINING RESULT.
SUB P,[XWD 4,4] ;FORGET ABOUT THINGS IN STACK.
POPJ P,
FAPAR: ;PARAMETER IS NAME OF FUNCTION ARRAY.
PUSHJ P,GAPAR ;CALL GENERATOR.
PUSHJ P,SCAN
JRST FUNC2
FDPAR: PUSHJ P,GDPAR ;GENERATE A DUMMY PARAM.
JRST FUNC1
FDPAR2: PUSH OSP,[0] ;EMIT A DUMMY PARAM., BUT WITHOUT
JRST FUNC1 ;ANY INSTR. TO ZERO IT AT I-TIME.
; HERE ARE THE GLORIOUS, SUPER-INTELLIGENT, SCHIZOPHRENIC
; CODE GENERATORS. LOOK UPON THEM AND BE AMAZED.
MULGEN: SKIPA T,[FMP] ;GENERATE A MULTIPLY.
ADDGEN: MOVSI T,(<FAD>) ;SEE THE STUPID FAIL !
PUSH P,T
PUSHJ P,GGET1 ;GET ONE OPERAND IN AN AC.
GEN1: POP P,C ;RECOVER THE OPCODE.
GEN2: PUSHJ P,EMINST ;EMIT THE INSTRUCTION.
JRST MRKAC ;MARK THE AC FULL AND RETURN.
DIVGEN: SKIPA T,[FDV] ;GENERATE A DIVIDE ...
SUBGEN: MOVSI T,(<FSB>) ; .. OR A SUBTRACT.
PUSH P,T
PUSHJ P,GGET2 ;GET FIRST OPERAND IN AN AC.
JRST GEN1
UMGEN: PUSHJ P,GMURKA ;UNARY MINUS. GET THE OPERAND.
PUSH P,E
PUSHJ P,GETAC ;GET A FREE AC.
POP P,B ;BRING BACK AC ADDRESS.
MOVSI C,(<MOVN>) ;EMIT GOOD INSTRUCTION.
JRST GEN2
MULOP←←MULGEN
ADDOP←←ADDGEN
SUBOP←←SUBGEN
DIVOP←←DIVGEN
ASNGEN: ;COMPILE STORE FOR ASIGNMENT STMT.
ASNOP: PUSH P,-1(OSP) ;SAVE PTR. TO GOOD BITS OF VRBL.
PUSHJ P,GMURK ;GET EXPR. AND LEFT-PART VARIABLE.
EXCH D,E ;GET THEM IN RIGHT ORDER.
PUSHJ P,GG2 ;GET EXPR. IN AN AC.
POP P,T ;RECOVER PTR. TO VRBL. GOOD BITS WORD...
MOVE H
LSH =35-PRVBT ;PUT R-TIME FLAG IN RIGHT POSITION...
TLNN B,GPBIT ;IF NOT A P-SYMBOL,
ORM (T) ;SET R-TIME BIT CORRECTLY.
MOVSI C,(<MOVEM>) ;EMIT A MOVEM TO STORE VALUE OF EXPR.
JRST EMINST
; HA! I BET YOU THOUGHT WE WERE DONE, DIDN'T YOU ?
; WELL, HERE BEGINS AN INFINITE REGRESSION OF
; CLEVER ,GRUBBY ROUTINES WHICH DO THE
; DIRTY WORK FOR THE GENERATORS.
; GPONDER REMOVES THE TOP THING FROM THE OPERAND STACK,
; LOVINGLY PATS ITS MAGIC BITS INTO STANDARD FORMAT,
; AND SETS A FLAG INDICATING WHETHER IT IS AN
; R-TIME VARIABLE OR NOT.
GPONDER: MOVEI H,0 ;RESET R-TIME VARIABLE FLAG.
GPOND1: POP OSP,T ;GET TOP THING.
TLNE T,FOOBIT ;IS IT A FOO-SYMBOL?
JRST GPFOO ;YES.
TLNE T,NUMFLG ;A NUMBER ?
POPJ P, ;YES. WE ARE DONE.
TLNE T,SRACBT+RVBT ;AN R-TIME AC OR VARIABLE ?
MOVEI H,1 ;YES. SET R-TIME FLAG.
TLNE T,SRACBT ;AN R-TIME AC ?
SETZM RACS(T) ;YES. MARK IT FREE.
TLNE T,SIACBT ;(SAME FOR I-TIME AC).
SETZM IACS(T)
TLNE T,VRBLBT ;A VARIABLE ?
HRR T,(T) ;YES. GET RT. HALF GOOD BITS.
POPJ P,
GPFOO: TRZE T,400000 ;IS IT A P-SYMBOL?
JRST GPONP ;YES.
GPONU: MOVEI H,1 ;REFERS TO A UINIT GENERATOR; SET FLG.
HRRZS T ;GET NO. OF UNIT GEN.
CAMLE T,UOPTR ;NO FORWARD REFERENCES TO UNIT GEN.
ERROR (FORWARD REF. TO UNIT GENERATOR)
MOVE T,UOTBL(T) ;GET ADDRESS OF ITS OUTPUT CELL.
POPJ P,
GPONP:
ADDI T,PBASE ;BASE OF PARAM. ARRAY.
HRLI T,GPBIT ;MARK AS P-SYMBOL.
POPJ P,
; GMURK CLEVERLY GPONDERS THE TOP TWO OPERANDS,
; AND IF ONE OF THEM IS AN R-TIME VARIABLE
; AND THE OTHER IS AN I-TIME AC OR A P-SYMBOL, IT STORES
; THE LATTER WHERE IT WILL BE SAFE UNTIL R-TIME.
GMURKA: MOVEI H,0
GMURK1: TDZA T,T ;PROCESS ONLY TOP STACK ELEMENT.
GMURK: PUSHJ P,GPONDER ;GPONDER THE FIRST OPERAND.
PUSH P,T ;SAVE IT
PUSHJ P,GPOND1 ;NOW THE SECOND.
POP P,D ;PUT THEM BOTH IN SOME SAFE ACCUMULATORS.
MOVE E,T
SKIPN H ;IS EITHER ONE AN R-TIME VARIABLE ?
POPJ P, ;NO.
TLNE E,SIACBT+GPBIT ;AN I-TIME AC OR A P-SYMBOL ?
JRST GM2 ;YES.
TLNN D,SIACBT+GPBIT ;HOW ABOUT THIS ONE ?
POPJ P, ;HE ISN'T, EITHER. RETURN.
SKIPA F,[EXP D] ;BAGBITING MACROX.
GM2: MOVEI F,E ;SEE THE TWO HEADED MONSTER.
MOVE A,(F) ;GET THE RELEVANT THING.
TLNE A,GPBIT ;A P-SYMBOL, OR AN I-TIME AC ?
JRST GM3 ; A P-SYMBOL.
MOVE B,VLOC ;STORE IT IN VARIABLE AREA.
GM3B: MOVEM B,(F) ;CHANGE THE OPERAND INDICATOR.
MOVE C,[MOVEM EMICDI] ;EMIT THE STORE INSTRUCTION.
PUSHJ P,EMINST
JRST EMDV ;MAKE APLACE IN THE VARIABLES FOR IT.
GM3: SKIPN T1,(A) ;HAS THE PARAMETER ALREADY BEEN
JRST GM3A ; PUT IN VAR. AREA ?
MOVEM T1,(F) ;YES. CHANGE POINTER.
POPJ P,
GM3A: PUSHJ P,GETIAC ;FIND FREE I-TIME AC.
MOVE B,(F)
MOVE T,VLOC ;GET VAR. LOC. CTR.
TLO T,GPBIT
MOVEM T,(B) ;ENTER IN PARAMTER TABLE.
MOVE C,[MOVE EMICDI] ;EMIT INSTR. TO
PUSHJ P,EMINST ;PICK UP THE PARAMETER.
MOVE B,VLOC ;GET LOC. AGAIN...
TLO B,GPBIT ;MARK AS A P-SYMBOL.
JRST GM3B ;NOW STORE THE PARAMETER IN VAR. AREA.
; STILL MORE KLUGES. PAUSE TO GET YOUR BREATH NOW.
;GGET1 ARRANGES TO HAVE ONE OF THE TOP TWO OPERANDS
; IN AN AC. IT RETURNS IN 'A' THE ADDRESS OF THAT AC, AND
; IN 'B' THE ADDRESS OF THE OTHER OPERAND, WITH RELOCATION
; BITS IN LEFT HALF.
GGET1: PUSHJ P,GMURK ;PROCESS TOP TWO OPERANDS.
TLNN D,SIACBT+SRACBT ;IS FIRST ONE IN AN AC ?
JRST GG2 ;NO.
MOVE A,D ;YES. WE ARE DONE.
MOVE B,E
POPJ P,
GGET2: PUSHJ P,GMURK ;GGET2 GETS SECOND OPERAND IN AN AC.
GG2: MOVE A,E ;PUT OPERAND IN A.
TLNE A,SIACBT+SRACBT ;IS IT ALREADY IN AN AC ?
JRST GL2A ;YES. WIN BIG.
TLNE D,SIACBT+SRACBT ;HOW ABOUT OTHER OP. ?
SETOM @ACTB3(H) ;AN AC... MARK IT FULL TEMPORARILY.
PUSHJ P,GETAC ;GET A FREE AC OF THE APPROPRIATE KIND.
MOVE B,E ;LOAD SECOND OPERAND INTO IT.
MOVSI C,(<MOVE>) ;EMIT LOAD INSTR.
PUSHJ P,EMINST
TLNE D,SIACBT+SRACBT ;IF OTHER OP. IS IN AN AC,
SETZM @ACTB3(H) ;MARK IT FREE NOW.
GL2A: MOVE B,D ;PUT OTHER OP IN B.
POPJ P,
; EMINST IS THE INSTRUCTION EMITTING ROUTINE. CALL IT
; WITH AC IN A,THE ADDRESS (+ RELOC. BITS) IN B, AND
; OPCODE IN C. IF RIGHT HALF OF C IS NON-ZERO, IT IS THE
; ADDRESS OF THE APPROPRIATE BUFFER EMITTING ROUTINE;
; OTHERWISE THE INSTR. IS PLACED IN THE I-TIME
; OR R-TIME BUFFERS ACCORDING TO THE STATE OF THE FLAG IN H.
EMINST: PUSH P,A ;SAVE IT.
HLL A,C ;ASSEMBLE INSTRUCTION IN A.
DPB A,[POINT 4,A,12] ;PUT IN AC FIELD.
HRR A,B ;ALSO ADDRESS.
TLZE B,FPARBT ;IS ADDR. A FORMAL PARAMETER ?
TLO A,20+RA ;YES. ADD INDIRECT BIT AND INDEX.
HLRZS B ;PUT RELOC. BITS FOR ADDRESS IN RIGHT HALF OF B.
PUSH P,[EXP EMIN2] ;RETURN ADDRESS.
TRNE C,-1 ;RH OF C =0 ?
JRST (C) ;NO.
JRST @EMITB(H)
POPAJ: ;A USEFUL ENTRY POINT.
EMIN2: POP P,A
POPJ P,
EMITB: EMICDI
EMCDI
ACTB3: XWD D,IACS
XWD D,RACS
;GETAC SEARCHES FOR A FREE AC, EITHER I-TIME OR
; R-TIME, AS INDICATED BY THE STATE OF THE FLAG IN H.
GETAC: SKIPE H ;ARE WE EMITTING R-TIME CODE ?
GETRAC: SKIPA T3,[XWD SRACBT+A,RACS] ;YES, FIND A R-TIME AC.
GETIAC: MOVE T3,[XWD SIACBT+A,IACS] ;FIND AN I-TIME AC.
MOVE A,[XWD -NACS,NFACS] ;CONSIDER ONLY AC'S 4-14
TRNE FL,CSBRBT ; ..UNLESS WE'RE COMPILING A FUNCTION..
MOVE A,[XWD -NFACS,0] ;WE ARE. CONSIDER ONLY 0-3.
SKIPE @T3 ;INDIRECT ADDRESSING IS GOOD FOR YOU.
AOBJN A,.-1 ;NOT FREE. TRY FOR NEXT ONE.
JUMPLE A,GETAC3 ;DID WE FIND ONE ?
PUSHJ P,GETAC2 ;NO. STORE ONE.
GETAC3: HRLI A,SRACBT ;YES. PUT IN APPROPRIATE FLAG BITS.
TLNN T3,SRACBT ;OOPS, IT'S AN I-TIME AC.
HRLI A, SIACBT
POPJ P,
GETAC2: SUBI A,1 ;STORE HIGHEST AC.
GSVAC: MOVE T,@T3 ;FIND OUT WHO'S IN HIM.
MOVE B,VLOC ;GET LOC. TO STORE HIM IN.
MOVEM B,(T) ;FIX UP HIS STACK ENTRY.
SETZM @T3 ;MARK HIM EMPTY.
MOVSI C,(<MOVEM>) ;EMIT THE STORE INST.
PUSHJ P,EMINST
JRST EMDV ;LEAVE A PLACE IN VARIABLES AREA.
;MRKAC PUTS THE AC SYMBOL IN A BACK ON THE STACK AND MARKS
; THE CORRESPONDING AC AS FULL.
MRKAC0: IOR A,MRKTAB(H) ;MARK IAC 1 OR RAC 1 FULL.
MRKAC: PUSH OSP,A ;PUT IT ON STACK.
TLNN A,SRACBT ;AN R-TIME AC?
HRRZM OSP,IACS(A) ;NO, MARK CORRESPONDING I-TIME AC FULL.
TLNE A,SRACBT
HRRZM OSP, RACS(A)
CPOPJ: POPJ P,
MRKTAB: XWD SIACBT,0 ;DESCRIPTOR FOR I-TIME AC NO. 1
XWD SRACBT,0 ;R-TIME AC 1.
;; MORE GENERATORS.
GAPAR: ;; HANDLE A PARAMETER WHICH IS AN ARRAY NAME.
TLNE A,SWVBT ;IS IT AN ARRAY IDENTIFIER OR
HRR A,(A)
TLNE A,FPARBT+SWVBT ; A FORMAL PARAMETER ?
JRST GAPR1 ;YES.
TLNE A,FOOBIT ;BETTER BE A FOO-SYMBOL, THEN....
TRZN A,400000 ;FURTHERMORE, IT MUST BE A P-SYM.
ERROR(IMPROPER ARRAY PARAMETER)
PUSH P,A ;SAVE P NO.
PUSHJ P,GETIAC ;FIND FREE I-TIME AC.
POP P,B
ADDI B,PBASE ;CALC. ADDR. OF P-SYMBOL.
MOVE C,[MOVE EMICDI] ;EMIT MOVE AC,P-SYMBOL TO THE
PUSHJ P,EMINST ;I-TIME CODE STREAM.
HRLI A,(<MOVEM>) ;NOW A MOVEM AC, INTO THE PARAMETER
DPB A,[POINT 4,A,12] ;LOCATION.
TRZA A,-1 ;CLEAR ADDRESS FIELD.
GDPAR: MOVSI A,(<SETZM>) ;PARAM. LIST AT I-TIME.
PUSH OSP,ILOC ;PUT ARRAY MARKER IN OPERAND
MOVSI T,SWVBT+FPARBT ;STACK SO A FIXUP CAN BE EMITTED TO
IORM T,(OSP) ;THE UPCOMMING HRRM WHEN THE PARAMETERS
MOVEI B,0 ;NO RELOCATION, PLEASE.
JRST EMICDI ;EMIT HRRM TO STORE ARRAY LOC. INTO
;PARAMETER CELL, AND RETURN.
GAPR1: PUSH OSP,A ;PLACE IN OPERAND STACK.
POPJ P,
GFUNC: ;; GENERATE A FUNCTION CALL.
MOVE A,@-3(P) ;PICK UP THE CALLING INSTR. FOR THE FUNCTION.
MOVE D,RLOC ;DECIDE WHETHER CALL IS TO BE IN
MOVEI H,0 ;R-TIME OR I-TIME CODE.
TLZN A,20 ;IND. BIT IN INSTR. SAYS R-TIME ALWAYS.
CAME D,-4(P) ;ALSO R-TIME IF ANY R-TIME PARAMETERS
MOVEI H,1 ;HAVE BEEN COMPILED.
GFUNC8: MOVE T3,ACTB1(H)
MOVSI A,-NFACS ;PREPARE TO SEARCH AC'S 0-4.
SKIPN T,@T3 ;IS THIS ONE IN USE ?
AOBJN A,.-1 ;NO.
JUMPG A,GFUNC6 ;DID WE FIND A BUSY ONE ?
PUSHJ P,GSVAC ;YES. SAVE IT.
JRST GFUNC8
GFUNC6: PUSH P,-1(P) ;PUT PAR. COUNT ON STACK.
HRRZM P,TEMP1# ;SAVE LOC. OF COUNT.
GFUNC5: SOSGE @TEMP1 ;MORE PARAMS ?
JRST GFUNC4 ;NO.
PUSHJ P,GMURK1 ;GET A PARAM.
TLNN E,SWVBT
TLNN E,FPARBT ;IS IT A FORMAL PARAMETER ?
JRST GFUNC7 ;NO, THANK GOD.
MOVE A,E ;SIGH. THE PRICE OF HONESTY ...
HRLI A,(<MOVE (RA)>) ;EMIT CODE TO PICK UP THE
MOVEI B,0 ;PARAM. PTR. AND PUT IT IN THE
PUSHJ P,@EMITB(H) ;CURRENT CALLING SEQUENCE.
MOVE E,ILOC(H) ;SAVE ILOC OR RLOC FOR LATER FIXUP.
TLO E,FPARBT ;MIGHT AS WELL USE THIS BIT...
MOVSI A,(<MOVEM>) ;NOW THE SECOND INSTR....
PUSHJ P,@EMITB(H)
GFUNC7: PUSH P,E ;SAVE IT.
JRST GFUNC5 ;GET ANOTHER.
GFUNC4: POP OSP,A ;NOW EMIT THE CALLING INSTR.
GFUNC2: LDB B,[POINT 4,A,17] ;RELOC. BITS.
TLZ A,37
TLZE A,SWVBT ;IS IT AN ARRAY NAME ?
TLO A,INSXR ;YES. ADD INDEX FIELD.
GFUNC3: PUSHJ P,@EMITB(H) ;
POP P,A ;GET PARAM. FROM STACK.
JUMPL A,CPOPJ ;IF IT'S THE MARK, RETURN.
TLZN A,FPARBT ;IS IT A FORMAL PARAMETER ?
JRST GFUNC2 ;NO. EMIT IT.
MOVEI B,.FXBTS ;YES. EMIT A FIXUP TO THE RIGHT INSTRUCTION.
TLZ A,400000+LRFXBT+SWAPBT ;A REPLACEMENT FIXUP TO RT. HALF.
TLO A,RRFXBT
PUSHJ P,@EMITB2(H) ;EMIT IT TO I-TIME OR R-TIME BUFER.
MOVEI B,0 ;NOW RESERVE SPACE FOR THE PARAM.
JRST GFUNC3
EMITB2: EMICD
EMCD
ACTB1: XWD SIACBT+A,IACS ;PTR. TO IACS,INDEXED BY B.
XWD SRACBT+A,RACS
;; UTILITY RUOTINE TO ENTER AN ITEM IN THE MAIN SYMBOL TAB.
GETNAM: PUSHJ P,SCANV ;SCAN AN IDENTIFIER.
GETNM1: AOS T,(P) ;TO SKIP PARAM ON RETURN.
JUMPE A,GNM2 ;SHOULD BE UNDEFINED...
TLOE A,DF ;IT'S NOT. MAYBE IT'S A DELIMITER ?
ERROR (MISSING IDENTIFIER)
TLNN A,@-1(T) ;NO. MAYBE ALREADY RIGHT TYPE ?
ERROR (MULTIPLY DEFINED SYMBOL)
SKIPGE -1(T) ;AH, IT IS. SHOULD WE REENTER IT ?
POPJ P, ;NO. ITS OLD ENTRY WILL DO.
GNM2: HRLZ A,-1(T) ;YES. GET TYPE BITS.
AENTER: HRRZ JOBFF ;GET NEXT FREE LOCATION.
HRRZ B,CBNO ;GET BUCKET NO. OF THING JUST SCANNED.
EXCH BUCTBL(B) ;UPDATE BUCKET HEAD.
AOS B,JOBFF
MOVEM -1(B) ;PUT THE LINK IN THE NEW ENTRY.
MOVEM A,1(B) ;PUT THE RANDOM GOOD BITS IN.
MOVE ACCUM ;GET FIRST WORD OF NAME.
MOVEM (B) ;PUT IN TABLE.
AOS B,JOBFF
MOVEI T,ACCUM+1 ;PREPARE TO MOVE REST OF NAME.
AEL1: AOS JOBFF
SKIPN T1,(T) ;ANY MORE OF THE NAME ?
JRST AEL2 ;NO.
MOVEM T1,@JOBFF ;YES. PUT IN TABLE.
CAIL T,ACCUM+2 ;UNLESS FIRST OR SECOND WORD,
SETZM (T) ;ZERO WORD IN ACCUM.
AOJA T,AEL1
AEL2: HRRZ JOBSYM ;GET BOTTOM OF BUFFER AREA.
CAMG JOBFF ;HAVE WE OVERRUN IT ?
ERROR(CORE IS FULL)
HRR A,B
HRRZ JOBFF
HRLM JOBSA
POPJ P,
;; INITIALIZATION OF THE COMPILER.
EXTERNAL JOBFF,JOBSA
JOBSYM: 0
SCOMPA: MOVE OSP,[XWD -LOSTK,OSTK-1] ;INIT. OPERAND STACK.
PUSH OSP,JOBSYM ;...SO WE CAN RESTORE IT LATER.
MOVSI IRELBT ;INIT THE THREE LOCATION
MOVEM ILOC ;COUNTERS (APPROPRIATE RELOCATION
MOVSI RRELBT ;BITS LIVE IN LEFT HALF OF EACH).
MOVEM RLOC
MOVSI VRELBT
MOVEM VLOC
MOVEI T1,2 ;SET UP THE THREE CHAINS OF OUTPUT
SCMP1: SETZM OBPTR(T1)
PUSHJ P,GBUF ;BUFFERS.
HRRZM T,FCBUF(T1) ;PTR. TO FIRST BUFFER OF CHAIN
SOJGE T1,SCMP1 ;DO FOR ALL THREE CHAINS.
SETZM IARR1 ;ZERO SOME TABLES AND STUFF.
MOVE [XWD IARR1,IARR1+1]
BLT IARR2-1
MOVEI FL,0 ;CLEAR FLAGS.
POPJ P,
SCOMP: PUSHJ P,SCOMPA ;INIT. THE COMPILER.
MOVE [XWD IARR2-1,IARR2]
BLT IARR3-1 ;ZERO REST OF TABLES.
POPJ P,
;; SYNTAX ANALYZER.
SSTATL: PUSHJ P,SMCSCN ;SCAN NEXT NON-SEMICOLON.
STATL: CAMN A,FINV ;IS IT A FINISH ?
JRST ENDP1 ;YES.
PUSHJ P,STAT ;NO. SCAN A STATEMENT.
JRST SSTATL ;GO BACK FOR MORE.
SSTAT: PUSHJ P,SMCSCN
STAT: MOVEI H,0 ;CLEAR 'R-TIME CODE' FLAG.
JUMPGE A,STAT2 ;A DELIMITER ?
TLNE A,DECLBIT ;YES. A DECLARATION ?
JRST (A) ;YES. DISPATCH TO RIGHT ROUTINE.
STAT2: PUSHJ P,STMT1 ;IT HAS TO BE A STMT1.
STATL1: CAME A,SEMICV ;SEMICOLON AFTER EVERY STMT.,PLEASE.
ERROR (MISSING SEMICOLON) ;I HATE MYSELF FOR THIS.
TDZ FL,[XWD ERRFLG,EXTFLG] ;TURN OFF ERROR FLAG.
POPJ P, ;END OF STATEMENT.
EXTD: PUSHJ P,SCAN ;"EXTERNAL" DECLARATION.
CAME A,FUNV ;BETTER BE "FUNCTION".
ERROR (<EXTERNAL FUNCTIONS ONLY,PLEASE.>)
TRO FL,EXTFLG ;SET FLAG.
JRST DFUNC
SSTMT1: PUSHJ P,SCAN
STMT1: SKIPN A ;IS IT UNDEFINED ?
ERROR (UNDEFINED IDENTIFIER)
STMT1A: TLNE A,FUNBIT ;<STMT1>=<FUNCTION CALL> ! <ASN. STMT>
JRST SFUNC ;A FUNCTION CALL.
TLNN A,VRBLBT!FOOBIT ;BETTER BE A SIMPLE VARIABLE.
ERROR (SIMPLE VARIABLE REQUIRED HERE.)
PUSH OSP,A ;STACK IT.
PUSHJ P,SCAN ;GET LEFT ARROW.
CAME A,LARV
ERROR (ILLEGAL STATEMENT)
PUSHJ P,ASTMT1 ;IT'S AN ASSIGNMENT STMT. COMPILE IT.
JRST POPAJ ;RESTORE A(WHICH WAS SAVED BY ASTMT)
; AND RETURN.
SFUNC: PUSHJ P,FUNCAL ;COMPILE FUNCTION CALL
JRST SCAN ;RETURN.
SMSC1:
SMCSCN: PUSHJ P,SCAN ;SCAN PAST NEXT SEMICOLON.
SMCS1: CAMN A,SEMICV
JRST SMCSCN
POPJ P,
ENDSTL: RELEAS DT, ;ALL DONE. RELEAS INPUT DEVICE.
ENDP1:
MOVEI A,0
MOVEI B,.FXBTS ;PUT END MARKS IN THE BUFFERS.
PUSHJ P,EMCD
PUSHJ P,EMICD
PUSHJ P,EMVCD
POP OSP,JOBSYM ;RESTORE JOBSYM.
POPJ P,
EXTERNAL JOBDDT,JOBREL
DVRBL1: CAME A,COMMAV ;IS IT A COMMA ?
JRST STATL1 ;NO. END OF DECL.
DVRBL: PUSHJ P,SCAN ;GET NEXT ITEM.
CAMN A,CTBL+"/" ;IS IT A "/" ?
JRST DVRBL2 ;YES. DEFINE FOLLOWING VARIABLE AS R-TIME.
PUSHJ P,GETNM1 ;NO. MUST BE NAME OF VARIABLE. PUT IN SYM. TABLE.
XWD 400000,VRBLBT ;PARAM. TO GETNM1.
DVRBL4: JUMPL A,DVRBL3 ;WAS IT ALREADY DEFINED ?
AOS A,JOBFF ;NO, IT'S NEW. LEAVE WORD FOR THE VALUE.
SUBI A,1 ;GET PTR. TO THAT WORD.
HRRM A,(B) ;PUT IN GOOD BITS WORD (NO REL. BITS).
DVRBL3: PUSHJ P,SCAN ;GET COMMA OR SEMICOLON.
JRST DVRBL1 ;BACK FOR MORE.
DVRBL2: PUSHJ P,GETNAM ;SCAN AND ENTER NAME OF VARIABLE.
XWD 400000,VRBLBT!RVBT ;INCLUDE 'R-TIME' BIT.
JRST DVRBL4
DF5: CAME A,COMMAV ;ARE THERE MORE DEFINITIONS ?
JRST STATL1 ;NO.
DFUNC: TRO FL,CSBRBT+SFOOBT ;ENTER FUNCTION DEFINING MODE.
PUSHJ P,GETNAM ;GET FUNCTION NAME.
EXP FUNBIT ;PARAMETER TO GETNAM.
PUSH P,BUCTBL ;####$$%%$ A TEMPORARY KLUGE !!
MOVE A,JOBFF ;GET FIRST FREE STORAGE LOC.
HRRM A,(B) ;MAKE GOOD BITS WORD POINT THERE.
HRLI A,600 ;MAKE A INTO A BYTE POINTER.
PUSH P,A
PUSH P,A
IBP (P) ;THIS POINTER IS FOR PARAMETER DESCRIPTORS.
HRLI A,400000+LRFXBT+RRFXBT ;NOW EMIT FIXUP TO THE
;LOCATION IN THE SYM. TABLE WHICH WILL
MOVEI B,.FXBTS ;CONTAIN THE CALLING INSTR. FOR THE
; FUNCTION, SO IT CAN BE UPDATED AT
PUSHJ P,EMICD ;LOAD TIME WITH THE RELOCATED ADDRESS OF THE FUNCTION.
ADDI A,5 ;LEAVE ENOUGH ROOM FOR 22 PARAMETER
HRRZM A,JOBFF ;DESCRIPTORS.
TRNN FL,EXTFLG ;IS IT AN EXTERNAL FUNCTION ?
SKIPA A,ILOC ;NO. ADDRESS IS IN ILOC.
PUSHJ P,SYMSCH ;YES. FIND STARTING ADDRESS.
TLO A,(<JSA RA,>) ;MAKE INTO A CALLING INSTR.
MOVEM A,@-1(P) ;PLACE IN SYM. TABLE.
LDB B,[POINT 4,A,17] ;GET THE RELOCATION BITS.
TLZ A,17 ;TURN THEM OFF IN THE INSTRUCTION WORD.
PUSHJ P,EMICD ;EMIT AS VALUE OF ABOVE FIXUP.
PUSH P,[-1] ;INIT. THE PARAMETER COUNT.
PUSHJ P,SCAN ;LOOK AT NEXT THING.
CAME A,LPARV ;A ( ?
JRST DFNOPR ;NO. THERE ARE NO PARAMETERS.
DF2: PUSHJ P,SCAN ;SCAN A PARAMETER.
CAME A,ARRV ;IS IT AN ARRAY NAME ?
JRST DF2A ;NO.
TRO FL,ARRFLG ;YUP. SET FLAG AND GET NAME OF
JRST DF2 ;PARAM.
DF2A: TLNE A,DF+NUMFLG
ERROR (ILLEGAL FORMAL PARAMETER)
AOS A,(P) ;INCREMENT PARAMETER COUNT.
HRLI A,FPARBT!VRBLBT ;MAKE A INTO FORMAL PARAM. INDICATOR
PUSHJ P,AENTER ; AND ENTER THE SYMBOL.
MOVEI 2 ;PUT 'ORDINARY' FLAG IN THE PARAMETER
TRZE FL,ARRFLG ;AN ARRAY NAME PARAM. ?
MOVEI 1 ;YES. USE RIGHT DESCRIPTOR BIT.
IDPB -1(P) ;DESCRIPTOR FOR THIS PARAM.
PUSHJ P,SCAN
CAMN A,COMMAV ;A COMMA ?
JRST DF2 ;YES LOOK FOR MORE PARAMETERS.
CAME A,RPARV ;IT BETTER BE A ).
ERROR (MISSING RIGHT PAREN.)
PUSHJ P,SCAN ;GET THE =.
MOVEI B,0 ;FLAG END OF PARAMETER DESCRIPTORS.
IDPB B,-1(P)
DFNOPR: TRNE FL,EXTFLG ;IS THIS AN EXTERNAL FUNCTION ?
JRST DF4 ;YES. LOOK FOR NO DEFINITION.
CAME A,CTBL+"="
ERROR (MISSING = IN FUNCTION DEFINITION)
PUSHJ P,EMICDI ;LEAVE ROOM FOR THE JSA WORD.
TRZ FL,SFOOBT ;LET SCANNER SEE FOO-SYMBOLS AGAIN.
PUSHJ P,SEXPR ;SCAN AN EXPRESSION.
DF4: PUSH P,A
TRNE FL,EXTFLG ;AN EXTERNAL ?
SKIPA E,[XWD SIACBT,0] ;YES. RESULT ALWAYS IN 0.
PUSHJ P,GMURK1 ;GET IT OFF STACK.
PUSHJ P,GG2 ;MAKE SURE ITS IN AN AC.
IDPB A,-2(P) ;TELL UNIVERSE WHICH AC .
AOS B,-1(P) ;ADJUST PARAMETER COUNT.
IDPB B,-3(P) ;PUT IN SYM. TABLE.
MOVEI A,RA ;EMIT RETURN INSTR.
MOVSI C,(<JRA RA,(RA)>)
TRNN FL,EXTFLG ;...UNLESS THIS IS AN EXTERNAL.
PUSHJ P,EMINST
AOS A,-2(P) ;FIND TOP OF PARAM. DESC. STRING.
HRRZM A,JOBFF ;RESET FREE STORAGE.
HRLM A,JOBSA
POP P,A
SUB P,[XWD 3,3] ;FORGET JUNK IN STACK.
POP P,BUCTBL ;##$$%$# MORE OF THAT KLUGE !!!
TRZ FL,CSBRBT+SFOOBT ;LEAVE FUNCTION DEFINING MODE.
JRST DF5 ;ALL DONE.
;; MORE SYNTAX ANALYZER. COMPILE AN INSTRUMENT DEFINITION.
CINS: PUSHJ P,GETNAM ;GET NAME OF INSTRUMENT.
EXP INSBIT ;PARAMETER TO GETNAM.
AOS A,JOBFF ;GET PLACE FOR MORE GOOD BITS..
SUBI A,1
HRRM A,(B) ;MAKE RANDOM BITS WORD POINT THERE.
HRLI A,RRFXBT ;RIGHT HALF REPLACEMENT TYPE FIXUP.
MOVEI B,.FXBTS ;EMIT FIXUP TO RIGHT HALF FROM
PUSHJ P,EMICD ;FIRST LOC. OF I-TIME CODE.
HRLI A,LRFXBT+SWAPBT ;FIXUP TO LEFT HALF FROM FIRST LOC.
PUSHJ P,EMCD ;OF R-TIME CODE.
CINS5: PUSHJ P,SCAN
CINS3: PUSHJ P,SMCS1 ;IGNORE SEMICOLON, IF ANY.
CAMN A,ENDV ;IS IT AN END ?
JRST CINSE ;YES.
TLNN A,UGBIT ;IS IT A UNIT GENERATOR CALL ?
JRST CINS4 ;NOT A UNIT GENERATOR.
HRRZM A,CINST1# ;SAVE IT.
PUSHJ P,SCAN ;PEEK AT NEXT THING.
CAMN A,CTBL+"[" ;IS IT A [ ?
JRST CUG1 ;YES. UNIT GEN. HAS CONTROLLED CALLING RATE.
MOVEM A,SNCHR ;NO, IT'S PROBABLY THE (. PUT IT BACK WHERE SCAN WILL SEE IT AGAIN.
PUSHJ P,CINS6 ;NOW COMPILE THE CALL ON THE UNIT GEN.
JRST CINS5 ;BACK FOR MORE.
CINS6: MOVE A,CINST1 ;RECOVER POINTER FOR USE OF FUNCAL.
PUSHJ P,FUNCAL ;COMPILE CALL ON THE UNIT GEN.
MOVE B,VLOC ;GET LOC. FOR OUTPUT OF UNIT GEN.
AOS C,UOPTR ;INCREMENT COUNT OF UNIT GENS.
MOVEM B,UOTBL(C) ;ENTER OUTPUT LOC. IN TABLE.
MOVE C,[MOVEM EMCDI] ;EMIT STORE INSTRUCTION TO
PUSHJ P,EMINST ;PUT OUTPUT OF UNIT GEN. AWAY.
PUSHJ P,EMDV ;MAKE ROOM IN VARIABLES AREA FOR IT.
MOVE T,@CINST1 ;RETRIEVE PTR. TO RANDOM GOOD BITS.
SKIPN A,-1(T) ;DOES UNIT GEN. HAVE I-TIME CODE?
POPJ P, ;NO.
PUSHJ P,EMIABS ;YUP. EMIT THE CALLING INSTR.
HRRZ A,RLOC ;AS PARAMETER, GIVE IT A PTR. TO
MOVEI B,RRELBT ;JUST AFTER THE MOVEM EMITTED
PUSHJ P,EMICDI ;ABOVE.
POPJ P,
CINS4: PUSHJ P,STMT1 ;ITS NOT A UNIT GEN. CALL.
JRST CINS3 ;NO
CINSE: SETZM IARR1 ;YES. ZERO THINGS.
MOVE [XWD IARR1,IARR1+1]
BLT IARR3-1
MOVE A,[POPJ P,] ;PUT RETURN INSTR. AT END OF
MOVEI B,0 ;THE I-TIME CODE.
PUSHJ P,EMICDI
PUSHJ P,EMCDI ;ALSO THE R-TIME CODE.
CINSR1: PUSHJ P,SCAN
JRST STATL1
;; IF THE NAME OF A UNIT GENERATOR IS FOLLOWED BY AN
;; EXPRESSION IN SQUARE BRACKETS, THE U.G. GETS CALLED ONLY
;; EVERY N TIME STEPS, WHERE N IS THE VALUE OF THE EXPRESSION.
;; N IS RECALCULATED EVERY TIME THE U.G. IS CALLED.
CUG1: MOVE C,[AOSGE EMCDI] ;INSTR. TO COUNT NO. OF TIME
;STEPS TO SKIP THIS UG.
MOVE B,VLOC ;GRAB LOCATION IN VARIABLE AREA
;TO HOLD COUNT OF TIME STEPS TO SKIP.
MOVEI A,0 ;NO AC FIELD, PLEASE.
PUSHJ P,EMINST ;EMIT THE AOSGE JUST AHEAD OF THE CODE TO CALL THE U.G.
MOVE C,[SETZM EMICDI] ;ALSO EMIT AN INSTR. TO THE I-TIME
MOVE B,VLOC ;CODE TO INIT. THE COUNTER LOCATION TO 0
;(SO U.G. GETS CALLED FIRST TIME).
PUSHJ P,EMINST
PUSH P,RLOC ;SAVE R-TIME LOC. COUNTER (FOR LATER
;FIXUP TO JRST WE ARE ABOUT TO EMIT).
PUSH P,VLOC ;ALSO VARIABLE LOC., FOR LATER LOADING
; OF THE STEPS-TO-SKIP COUNTER.
PUSHJ P,EMDV ;MAKE A WORD FOR IT.
MOVSI A,(<JRST>) ;NOW EMIT THE JUMP AROUND THE CALL OF
PUSHJ P,EMCDI ;THE U.G. !!"" N.B.: B IS 0 HERE FROM CALL ON EMDV !!
PUSHJ P,SEXPR ;NOW COMPILE THE EXPRESSION IN THE BRACKETS.
CAME A,CTBL+"]" ;SHOULD BE FOLLOWED BY ONE...
ERROR (MISSING ])
MOVEI H,1 ;INDICATE THAT WE ARE WORKING WITH R-TIME CODE...
PUSHJ P,GMURK1 ;..AND GET EXPR OFF OPERAND STACK.
PUSHJ P,GG2 ;NOW GET IT INTO AN AC.
MOVSI C,(<FIX>) ;EMIT INSTR. TO FIX VALUE OF EXPRESSION.
MOVEI B,233000 ;MAGIC NO. FOR ADDRESS OF FIX, HO HO.
PUSHJ P,EMINST
POP P,B ;GET LOCATION IN VARIABLE AREA OF THE STEPS-TO-SKIP COUNTER.
MOVSI C,(<MOVNM>) ;AND EMIT INSTR. TO STORE NEGATIVE OF COUNT THERE.
PUSHJ P,EMINST
PUSHJ P,CINS6 ;NOW COMPILE CALL ON UNIT GENERATOR.
POP P,A ;RECOVER LOC. OF THE JRST UNDER THE AOSGE.
MOVEI B,.FXBTS ;EMIT FIXUP TO MAKE IT POINT HERE (I.E., AFTER
PUSHJ P,EMCD ; END OF U.G. CALL).
JRST CINS5 ;ALL DONE.
;; THE WONDERFUL, WINNING LOADER.
R←←1
I←←2
V←←3
LOADER: MOVE R,JOBFF ;R-TIME CODE RELOCATION CONST.
HRRZ I,RLOC ;
ADD I,R ;I-TIME CONST.
HRRZ V,ILOC
ADD V,I ;VARIABLE RELOC. CONST.
MOVE T3,V
ADD T3,VLOC ;PROGRAM BREAK.
HRRZM T3,JOBFF
HRLM T3,JOBSA ;MAKE SURE IT TAKES.
HRL A,R ;ZERO THE PROGRAM AREA.
HRRI A,1(R)
SETZM (R)
BLT A,-1(T3)
MOVEI H,0 ;START WITH R-TIME CODE.
LD1: ADDI H,1 ;GO TO NEXT CHAIN OF BUFFERS.
CAILE H,3 ;ALL DONE ?
POPJ P, ;YES.
PUSH P,[LDL1] ;FAKE UP A RETURN TO LDL1.
MOVE C,(H) ;INIT. THE CURRENT LOC. COUNTER.
SKIPA F,FCBUF-1(H) ;PTR. TO FIRST BUF. OF CHAIN.
LD2: HRRZ F,(F) ;PTR. TO NEXT BUF. OF CHAIN.
HRRZ E,F ;SET UP BYTE PTR. TO RELOC. BITS.
HRLI E,200
HRRZI D,LOBUFS/12+2(F) ;PTR. TO DATA IN BUF.
HRLI D,-<LOBUFS-LOBUFS/12-2> ;WORD COUNT.
LDGW: AOBJP D,LD2 ;WORD COUNT EXHAUSTED ?
MOVE (D) ;NO. PICK UP NEXT DATA WORD.
ILDB A,E ;FIRST 2 REL. BITS.
ILDB B,E ;LAST 2.
POPJ P,
LDL: PUSHJ P,LDGW ;GET NEXT WORD FROM BUFFER.
LDL1: JUMPE A,LDF1 ;NO REL. GIVEN; MAY BE A FIXUP.
JUMPE B,LDRST ;IF NEITHER HALF, THEN IT'S A RESET.
PUSH P,CLD3 ;ANOTHER FAKE RETURN ADDRESS.
LDRL1: TRNE B,1 ;RELOCATE RIGHT HALF ?
ADD (A) ;YES.
TRNN B,2 ;LEFT HALF ?
POPJ P, ;NO.
MOVSS (A)
ADD (A)
MOVSS (A)
POPJ P,
LD3: ADDM (C) ;PUT IN CORE.
CLDL: AOJA C,LDL ;GET ANOTHER.
;; MORE LOADER (BUT NOT MUCH MORE, YOU WILL NOTICE !).
LDF1:
CLD3: JUMPE B,LD3 ;PERHAPS NOT A FIXUP.
JUMPE LD1 ;IT MIGHT EVEN BE AN END MARK.
LDB T3,[POINT 2,0,15] ;A FIXUP. GET REL. BITS FOR PTR.
DPB T3,[POINT 5,0,17]
PUSH P,0
JUMPG LDF2 ;IS VALUE OF FIXUP TO BE FOUND IN BUFFER ?
PUSHJ P,LDGW ;YES. GET IT.
PUSHJ P,LDRL1 ;PERFORM ANY INDICATED RELOCATION ON IT.
SKIPA T3,0 ;MOVE RELOCATED VALUE INTO T3.
LDF2: MOVE T3,C ;VALUE IS CURRENT LOCATION.
POP P,0 ;BRING BACK THE POINTER WORD.
TLNE SWAPBT ;SHOULD WE EXCHANGE HALVES OF THE VALUE ?
MOVSS T3 ;YES.
TLNE RRFXBT ;SHOULD WE REPLACE THE RIGHT HALF OF THE LOCATION ?
HRRM T3,@0 ;YES. SEE THE POINTER RELOCATION HAPPEN AUTOMATICALLY !!
TLNE LRFXBT ;REPLACE THE LEFT HALF ?
HLLM T3,@0 ;YES.
TLNN LRFXBT+RRFXBT ;IF NEITHER HALF REPLACED, THEN
ADDM T3,@0 ;IT'S AN ADDITIVE FIXUP.
JRST LDL ;BACK TO MAIN LOOP.
LDRST: HALT ;THE FEATURE YOU HAVE REQUESTED ...
DARR: PUSH P,[0] ;DEFINE SOME ARRAYS.
DARR1: PUSHJ P,GETNAM ;SCAN NAME.
XWD DF,SWVBT ;TYPE PARAMETER TO GETNAM.
PUSH P,A ;STACK PTR. TO ENTRY.
PUSHJ P,SCAN ;LOOK FOR COMMA.
CAMN A,COMMAV ;IS IT ONE ?
JRST DARR1 ;YES. GET MORE NAMES.
CAME A,LPARV ;NO. SHOULD BE A (.
ERROR(MISSING LEFT PAREN.)
PUSHJ P,SCAN ;GET THE DIMENSION.
TLNN A,NUMFLG ;MAKE SURE IT'S A NUMBER.
ERROR(IMPROPER DIMENSION)
MOVE B,(A) ;GET VALUE.
TLNN A,FIXFLG ;IS IT FLOATING ?
FIX B,233000
;***********↑↑↑↑↑↑↑
DARR3: AOS JOBFF ;GET FREE STORAGE PTR.
POP P,T ;PTR. TO NAME IN TABLE...
JUMPE T,DARR2 ;UNLESS ITS THE MARK.
JUMPG T,DARR4 ;WAS IT PREVIOUSLY DEFINED ?
HRRZ T1,(T) ;YES. GET ITS BASE ADDRESS.
CAMG B,-1(T1) ;IS NEW DIMENSION > OLD ?
JRST DARR3 ;NO. LEAVE OLD DEFINITION ALONE.
DARR4: AOS A,JOBFF ;INCREMENT FREE STG. PTR. AGAIN.
HRRM A,(T) ;PUT IN SYM. TABLE.
MOVEM B,-1(A) ;PUT DIMENSION IN -1TH ELEMENT.
HRLI A,INSXR ;PUT GOOD INDEX FIELD IN A...
MOVEM A,-2(A) ;PUT PTR. TO ARRAY WITH INDEX IN AR[-2]
ADDM B,JOBFF ;INCREMENT IT.
JRST DARR3 ;TRY FOR ANOTHER.
DARR2: PUSHJ P,SCAN ;GET THE ).
CAME A,RPARV
ERROR(MISSING RIGHT PAREN.)
PUSHJ P,SCAN
CAMN A,COMMAV ;A COMMA ?
JRST DARR ;YES. START OVER AGAIN.
HRRZ JOBSYM ;LET'S FIND OUT IF WE'VE LOST...
CAMG JOBFF ;IS TOP STILL ABOVE BOTTOM ?
ERROR(STORAGE IS FULL)
HRRZ JOBFF
HRLM JOBSA
JRST STATL1
; HERE IS THE OUTER LOOP OF THE WHOLE SYSTEM.
CHOWN1: PUSHJ P,INTER1 ;INTERPRET STATEMENT.
SCHOWN: PUSHJ P,SMSC1 ;GET FIRST NON-SEMICOLON.
CHOWN: CAMN A,PLAYV ;IS IT A 'PLAY' SECTION ?
JRST PLAY1 ;YES.
CAMN A,ALTV ;IS IT AN ALT MODE ?
JRST COMMND ;YES. A COMMAND FOLLOWS.
CAME A, COMPV ;A 'COMPILE' SECTION ?
JRST CHOWN1 ;NO. JUST A STATEMENT.
PUSHJ P,SCOMP ;INIT. THE COMPILER.
PUSHJ P,SSTATL ;COMPILE A STATEMENT LIST.
PUSHJ P,LOADER ;LOAD THE CODE.
JRST SCHOWN ;DONE WITH THAT SECTION.
PLAY1: PUSHJ P,GSBUF ;WE'RE GOING TO PLAY; GET SAMPLE BUFFER.
AOS SBCNT
PLAY1A: SETZM TIME# ;T←0.
SETZM RQPTR# ;RUN QUEUE IS EMPTY.
SETZM MAXSMP# ;INIT. THE MAXIMUM SAMPLE REMEMBERER.
PLAY2: PUSHJ P,SMSC1 ;SCAN A NON-SEMICOLON.
CAME A,FINV ;A 'FINISH ' ?
CAMN A,PLAYV ;... OR A 'PLAY' ?
JRST PTERM ;YES. END OF SECTION.
TLNE A,INSBIT ;AN INSTRUMENT NAME ?
JRST PINS ;YES. A NOTE STATEMENT.
PUSH P,[EXP PLAY2] ;NO. INTERPRET THE STATEMENT.
INTER1: CAME A,INSV
CAMN A,FUNV
ERROR (ILLEGAL 'PLAY' STATEMENT)
PUSHJ P,SCOMPA ;IT MUST BE A RANDOM STATEMENT.
;PREPARE TO INTERPRET IT BY INITIALIZING
;THE COMPILER.
PUSHJ P,STAT ;COMPILE THE STATEMENT.
INTERP: MOVE A,[JRST INTER2] ;PREPARE TO EXECUTE TEMPORARY
MOVEI B,0 ;CODE (I.E,RUN IN INTERPRET MODE).
PUSHJ P,EMICDI ;EMIT RETURN INSTR. AT END OF CODE.
PUSHJ P,ENDP1 ;CLEAN UP COMPILER.
PUSH P,JOBFF ;SAVE FREE STG. PTR.
PUSHJ P,LOADER ;LOAD THE TEMPORARY CODE.
MOVEM P,PSV1# ;SAVE IT.
MOVEM FL,FLSV1#
MOVE 17,P ;PTR. FOR (UGH! BLETCH!) FOOTRAN PGMS.
JRST @(P) ;EXECUTE IT.
INTER2: MOVE P,PSV1 ;RESTORE PUSHDOWN POINTER.
MOVE FL,FLSV1
POP P,0 ;RETRIEVE OLD STG. PTR.
HRRZM JOBFF ;FLUSH THE TEMP. CODE.
HRLM JOBSA ;(IT HAS TO GO HERE TOO.)
POPJ P, ;LOOK, MA, I'M AN INTERPRETER !!
;THIS CODE READS A NOTE STATEMENT, INITIALIZES THE
; INSTRUMENT, AND GETS IT TURNED ON AT THE RIGHT TIME.
PINS: MOVE A,(A) ;GET STARTING ADDRESSES FOR INSTRUMENT.
PUSH P,(A) ;SAVE THEM.
MOVEI PBASE ;PREPARE TO FILL THE P ARRAY WITH
MOVEM PPTR1# ;THE PARAMETERS TO THE INSTR.
PUSHJ P,SCOMPA ;INIT. COMPLR. FOR POSSIBLE EXPRESSIONS.
MOVE NCHNS ;GET NO. OF OUTPUT CHANNELS.
TLNE -1 ;IS IT FLOATING ?
FIX 233000
;**********↑↑↑↑↑↑↑↑↑
PINS2: MOVEM NCHNS
PUSH P,NUMBUC ;SAVE CURRENT STATE OF NUMBER
PUSH P,JOBFF ;BUCKET AND CORE TOP.
JRST PINSL ;INIT. THE COMPILER.
PINSL1: CAMN A,COMMAV ;OPTIONAL COMMA BETWEEN PARAMS...
PINSL: PUSHJ P,SCAN
AOS PPTR1 ;INCREMENT P-ARRAY POINTER.
CAMN A,COMMAV ;A COMMA HERE MEANS MISSING
JRST PINSL ;PARAM., SO DON'T CHANGE.
CAMN A,SEMICV ;SEMICOLON ?
JRST PINSB ;YES, END OF PARAMETERS.
PUSHJ P,EXPR ;PARAMETER MAY BE EXPRESSION.
PUSHJ P,GPONDER ;GET OPERAND POINTER FOR THE EXPR...
TLNE T,SIACBT ;IS VALUE OF EXPR AN AC SYMBOL ?
JRST PINS1 ;YES. IT HAS TO BE CALCULATED.
MOVE C,(T) ;PICK UP ITS VALUE.
MOVEM C,@PPTR1 ; SO PUT ITS VALUE IN P-ARRAY NOW.
JRST PINSL1
PINS1: PUSH P,A ;EXPR. GENERATED SOME CODE, EVIDENTLY.
MOVE A,T ;EMIT AN INSTRUCTION TO STORE THE
MOVE B,PPTR1 ;RESULTANT VALUE IN THE P-ARRAY.
MOVE C,[MOVEM EMICDI]
PUSHJ P,EMINST ;THE CODE WILL GET EXECUTED
PUSHJ P,INTERP ; RIGHT NOW.
PUSHJ P,SCOMPA
POP P,A
JRST PINSL1 ;BACK FOR MORE PARAMS.
;; MORE OF PINS.
PINSB: POP OSP,JOBSYM ;FLUSH COMPLR. OUTPUT BUFFERS.
POP P,0 ;RECOVER OLD CORE TOP.
MOVEM JOBFF ;RESET THINGS TO FORGET
HRLM JOBSA ;ABOUT THE NUMBERS WE DEFINED WHILE
POP P,NUMBUC ;SCANNING NOTE PARAMETERS.
MOVE A,SRATE ;GET NO. OF SAMPLES/SEC.
FDVR A,TIMESC ;DIVIDE BY BEATS/SEC.
MOVE B,PBASE+1 ;GET STARTING TIME FOR NOTE.
FMPR B,A ;CONVERT TO SAMPLES.
FADR B,[0.5]
FIX B,233000
;***********↑↑↑↑↑↑↑↑↑
MOVEM B,RQ1 ;PLACE AT BOTTOM OF RUN QUEUE.
FMPR A,PBASE+2 ;GET DURATION OF NOTE IN SAMPLES.
FADR A,[0.5]
FIX A,233000
;***********↑↑↑↑↑↑↑↑↑
ADD A,B ;CALC. ENDING TIME OF NOTE.
PUSH P,A ;SAVE SAME.
PUSHJ P,PLAYIT ;PLAY UP TO STARTING TIME OF NOTE.
PLYON: AOS A,RQPTR ;NOW TURN INSTRUMENT ON.
POP P,RQ1(A) ;PUT ENDING TIME IN RUNQUEUE, COL. ONE.
POP P,T ;GET STARTING ADDR. OF INSTRUMENT.
HLRZM T,RQ2(A) ;PLACE IN RUN QUEUE, COL. TWO.
PUSHJ P,(T) ;EXECUTE THE I-TIME CODE.
JRST PLAY2 ;BACK FOR MORE NOTE STATEMENTS.
PTERM: PUSH P,A ;HERE AT A 'PLAY' OR 'FINISH'.
MOVSI 200000
MOVEM RQ1 ;SET UP FAKE STARTING TIME.
PUSHJ P,PLAYIT ;FLUSH THE RUN QUEUE.
POP P,A
CAMN A,PLAYV ;WAS IT A 'PLAY' THAT WE SAW ?
JRST PLAY1A ;YES. START NEW SECTION.
PUSHJ P,OSBUF ;NO, A 'FINISH'. EMPTY THE
JRST SCHOWN ;SAMPLE BUFFER AND START OVER.
;; THIS ROUTINE GENERATES SAMPLES BY CALLING THE
;; INSTRUMENTS IN THE RUN QUEUE UNTIL IT IS TIME
;; TO TURN ON THE INSTRUMENT WHOSE STARTING TIME IS
;; IN THE ZEROTH LOCATION OF THE QUEUE, WHEN IT RETURNS.
;; INSTRUMENTS ARE TURNED OFF AS REQUIRED.
PLAYIT: MOVE A,RQPTR ;SEARCH FOR EARLIEST TIME IN QUEUE.
PLYT2: MOVEM A,PTMP# ;SAVE ITS LOCATION.
SKIPA H,RQ1(A) ;PICK IT UP.
CAMG H,RQ1(A) ;A NEW MINIMUM ?
SOJGE A,.-1 ;NO.
JUMPGE A,PLYT2 ;YES.
PLYT1: CAMN H,[XWD 200000,0] ;MIN. FOUND. IS IT THE TERMINATION
POPJ P, ; MARK ? IF YES, THEN RETURN.
SUB H,TIME ;IT'S NOT . CALC. DISTANCE IN FUTURE.
JUMPLE H,PLYT3 ;IF NOT IN FUTURE, FORGET IT.
ADDM H,TIME ;MOVE TIME TO NEW VALUE.
PLYT4: SKIPE OSP,RQPTR ;CYCLE THRU RUNNING INSTRS., IF ANY.
PUSHJ P,@RQ2(OSP) ;CALL AN INSTR.
SOJG OSP,.-1 ;CALL THEM ALL.
MOVEI F,1 ;START WITH CHANNEL 1.
PLYT5: SOSG SBCNT ;COUNT SAMPLE BUFFER COUNTER.
PUSHJ P,FSBUF ;FLUSH FULL BUFFER.
MOVEI B,0 ;PICK UP NEXT CHANNEL'S SAMPLE, AND
EXCH B,OUTA-1(F) ; ZERO THE LOCATION.
FAD B,[0.5] ;ROUND TO NEAREST INTEGER.
FIX B,233000 ;A. KOTOK SHOULD HAVE DONE THIS.
;************↑↑↑↑↑↑↑↑
MOVM A,B ;GET MAGNITUDE...
CAMLE A,MAXSMP ;IS THIS SAMPLE THE BIGGEST YET ?
MOVEM A,MAXSMP ;YUP.
IDPB B,SBPTR ;PLACE IT IN SAMPLE BUFFER.
CAMGE F,NCHNS ;LAST CHANNEL ?
AOJA F,PLYT5 ;NO. GET OTHER CHANNELS.
SOJG H,PLYT4 ;GENERATE REST OF SAMPLES.
PLYT3: SKIPG A,PTMP ;GET PTR. TO NEXT INSTR. OFF OR ON.
POPJ P, ;TIME TO TURN ONE ON.
SOS B,RQPTR ;REMOVE INSTR. FROM QUEUE.
MOVE RQ1+1(B) ;MOVE TOP ENTRY DOWN INTO VACANT
MOVEM RQ1(A) ;SPOT.
MOVE RQ2+1(B)
MOVEM RQ2(A)
JRST PLAYIT ;GO PLAY TILL NEXT EVENT.
;; RANDOM ROUTINES TO HANDLE THE SAMPLE OUTPUT BUFFER.
GSBUF: HRRZ T,JOBSYM ;GET A SAMPLE BUFFER.
SUB T,JOBFF ;HOW MUCH ROOM IS LEFT ?
SUBI T,4*LOBUFS ;(ALLOWING ROOM FOR CODE BUFFERS)
SKIPE BIGBIT
SETZM RCDFLG ;RCDFLG ALWAYS ZERO IF BIGBIT IS NON-ZERO
SKIPN BIGBIT ;SETS LSBUF TO 1024 IF EITHER BIGBIT OR RCDFLG!
SKIPE RCDFLG
SKIPA
JRST GSBUF1 ;1023 IS FOR DEFERRED LONGPLAY
CAIGE T,=1024 ;1024 IS FOR IMMEDIATE LONGPLAY WITH 'PLAY'
ERROR (ADD 1K OF CORE!)
MOVEI T,=1023
SKIPGE RCDFLG ;IS IT POSITIVE OR ZERO?
MOVEI T,=1024 ;NO, RCDFLG←-1; IS FOR IMMEDIATE LONGPLAY
GSBUF1: MOVEM T,LSBUF ;PUT AWAY.
MOVNS T
PUSHJ P,GFS ;GRAB ENOUGH FREE STORAGE...
HRRZM T,SBBOTT# ;SAVE PTR. TO BUFFER.
FSBUF2: HRLI T,441400 ;MAKE BYTE POINTER.
SKIPE BIGBIT ;IS IT 18 BIT?
HRLI T,442200 ;YES. RESET BYTE SIZE
MOVEM T,SBPTR# ;
MOVE T,LSBUF ;GET LENGTH OF BUFFER.
ASH T,1 ;SAMPLE CT = LSBUF *2 FOR 18 BIT
SKIPN BIGBIT ;IS IT 18 BIT?
ADD T,LSBUF ;NO, MAKE * 3.
MOVEM T,SBCNT#
POPJ P,
OSBUF: HRRZ LSBUF ;THROW OUT SAMPLE BUFFER...
ADDM JOBSYM
MOVEI 0
SKIPA T,SBCNT
IDPB 0,SBPTR
SOJG T,.-1
JRST FSBUF
SMPOUT: MOVE SBBOTT
MOVEM IBOTT
; MAR 16,71 MOVE BIGBIT
; MAR 16,71 MOVEM IBIT#
JSA 16, SMPLS ;CALL WRITING ROUTINE
JUMP LSBUF
JUMP SBCNT
IBOTT: 0
JUMP MAXSMP
; MAR 16,71 JUMP IBIT
JUMP BIGBIT
JUMP RCDFLG ;RCDFLG←-1 WRITES ONE LONG .DMD FILE 6/71
SKIPN BIGBIT
SKIPE RCDFLG ;RCDFLG ON?
SKIPE DOPLAY ;PLAY ANYWAY?
JRST FSBUF1 ;GO TO PLAY
JRST FSBF2A ;DOESN'T PLAY
FSBUF: SKIPN BIGBIT
SKIPE RCDFLG# ;OUTPUT TO DISC?
JRST SMPOUT
FSBUF1: HRR SBBOTT ;CALCULATE NEGATIVE WORD COUNT.
SUB SBPTR
SUBI 1 ;PREVENT 0 WORD COUNTS.
HRRZ T,SBBOTT ;GET BOTTOM OF BUFFER....
HRLI -1(T) ; MINUS ONE.
MOVSM OUTWC ;PUT IOWD IN RIGHT PLACE.
;*** SEE EXPORT VERSION AT THIS POINT FOR OUTPUT *******************
PUSHJ P,FSBF1
JRST FSBF2
FSBF1: MOVE NCHNS ;NO. OF OUTPUT CHANNELS.
TLNE -1
FIX 233000
;**************↑↑↑↑↑↑↑
FSBF3: SUBI 1
DPB [POINT 2,OUTBIT,26] ;STEREO OR MONO MODE.
MOVM SPEED
TLNE -1 ;FIX IF NECESSARY.
FIX 233000
;*********↑↑↑↑↑↑↑↑↑
FSBF4: DPB [POINT 3,OUTBIT,32]
L1: INIT ADCHN,17
SIXBIT /AD/
0
ERROR (A-D UNAVAILABLE.)
POPJ P,
XGP: MOVSI 'XGP' ;TO AVOID XGP CONFILICT
DEVUSE 0,
HLRZ 0,0
CAIN 400000
POPJ P,
INIT 16,17
SIXBIT .XGP.
0
JRST XGP ;was JRA 16,2(16)
POPJ P,
FSBF2: PUSHJ P,XGP ;GO INIT THE XGP
MOVE T1,[647004,,0]
ADSMAP T1, ; SET AUDIO SWITCH TEMPORARILY TO DAC (JAM 7/24/75)
; THE OPTIONS WE ASKED FOR ARE TEMPORARY, WAIT FOR
; PAGE TO FINISH, DON'T INTERRUPT WITH MORE PAGES,
; DELAY BEEPS TO END OF XFR.
OUTSTR [ASCIZ /
TO DAC . . ./]
OUTPUT ADCHN,OUTWC ;EMPTY THE BUFFER.
OUTSTR [ASCIZ / DONE!
/]
SETO T1,
ADSMAP T1,
RELEAS ADCHN,
RELEASE 16,
FSBF2A: MOVE T,SBBOTT ;NOW SET UP POINTERS AGAIN.
JRST FSBUF2
OUTWC: 0
3650 ;MAGIC BITS FOR 136.
OUTBIT: 4000 ;BITS FOR A-D.
BLOCK 2
;; ERROR HANDLING(?) ROUTINES.
ERR1: 0 ;HERE FROM UUO TRAP.
TLNE FL,ERRFLG ;IN ERROR SKIPPING MODE ?
JRST 2,@ERR1 ;YES.
MOVEM 17,ERSVAC+17 ;NO. SAVE ACS.
MOVEI 17,ERSVAC
BLT 17,ERSVAC+16
JSR ERR2 ;PRINT MESSAGE.
MOVSI 17,ERSVAC ;RESTORE AC'S.
BLT 17,17
ERRX: TLO FL,ERRFLG ;ENTER ERROR-SKIPPING MODE.
RELEAS TTY,0
RELEAS DT,0
PUSHJ P,SETUP1
JRST GOB
JRST 2,@ERR1 ;TRY TO CONTINUE (HO, HO.).
ERSVAC: BLOCK 20
ERR2: 0 ;ERROR MESSAGE PRINTER.
HRRZI [ASCIZ /
$$$ ERROR: /]
JSR TXTOUT
HRRZ 40
JSR TXTOUT
HRRZI [ASCIZ /
/]
JSR TXTOUT
MOVE A,ISCP
MOVE B,A
MOVE C,B
ERR2B: ILDB A
CAIE 15
JRST ERR2A
MOVE C,B
MOVE B,A
ERR2A: CAME A,SCP
JRST ERR2B
JRST ERR2D
ERR2C: SOSGE TOB+2
OUTPUT TTY,0
IDPB TOB+1
ERR2D: ILDB C
CAME C,SCP
JRST ERR2C
SKIPN SNCHR
IDPB TOB+1
OUTPUT TTY,0
JRST @ERR2
SYMSCH: MOVEI T,6 ;LOOK UP EXTERNAL SYMBOL.
MOVE [POINT 6,ACCUM,5] ;PREPARE TO CONVERT TO
MOVEI B,0
SYMS1: ILDB A,0 ;RADIX 50.
JUMPE A,SYMS4
CAIN A,16
MOVEI A,73
CAIG A,5
ADDI A,70
CAIGE A,32
ADDI A,7
IMULI B,50
ADDI B,-26(A)
SOJG T,SYMS1
SYMS4: TLO B,40000
MOVE A,116
SYMS3: AOBJP A,SYMS2
CAME B,-1(A)
AOBJN A,SYMS3
SYMS2: SKIPL A
SKIPA A,[EXP NX]
HRRZ A,(A)
POPJ P,
NX: 0
ERROR (MISSING EXTERNAL FUNCTION)
JRST INTER2
INTERNAL RDNUM,MESS,PNUM
EXTERNAL JOBDDT;
PNUM: 0
MOVE P,JOBFF
SKIPGE A,@(RA)
OUTCHR ["-"]
MOVMS A
PUSHJ P,DECPNT
OUTPUT TTY,0
JRA RA,1(RA)
RDNUM: 0 ;NUMBER READER FOR FOOTRAN ROUTINES.
MOVE P,JOBFF ;GET TEMP. PDL
EXCH FL,FLSV1
RDNUM1: TLO FL,SNUMF1
PUSHJ P,SCAN
CAMN A,MINV ;A MINUS SIGN ?
TLOA FL,MINFLG ;YES. SET FLAG AND LOOP BACK.
TLNN A,NUMFLG ;IT IS A NUMBER, ISN'T IT ?
JRST RDNUM1 ;NO. IGNORE IT.
TLZE FL,MINFLG ;YES. HAVE WE SEEN A MINUS LATELY ?
MOVNS C ;YES.
MOVEM C,@(RA) ;PUT VALUE INTO PARAMETER.
EXCH FL,FLSV1
JRA RA,1(RA) ;RETURN TO (UGH ! BLETCH !) FOOTRAN.
MESS: 0 ;MESSAGE PRINTER FOR FOOTRAN ROUTINES.
HRRZ (RA) ;GET LOC. OF MESSAGE.
CALLI 3
JRA RA,1(RA)
FOOPRT: 0
MOVM A,@(RA)
TLNE A,777000
FIX A,233000
;**********↑↑↑↑↑↑↑↑↑↑↑
PUSHJ P,DECPNT
OUTPUT TTY,0
JRST 1(RA)
COMMND: MOVEI [ASCII /$/]
CALLI 3
PUSHJ P,SCANNS ;GET COMMAND.
JUMPL A,COMND1
MOVE ACCUM
MOVE 1,ACCUM+1
LSHC 6
CAMN [SIXBIT /RESET/]
JRST REST1
CAMN [SIXBIT /PRINT/]
JRST CPNT ;A 'PRINT' COMMAND.
CAMN [SIXBIT /P/]
JRST CPLX
CAMN [SIXBIT /DDT/]
JRST @JOBDDT
COMND1: MOVEI [ASCIZ /?? /]
CALLI 3
JRST SCHOWN
CPLX: PUSHJ P,CGNUM ;GET FOLLOWING NUMBER, IF ANY.
MOVEI T,1 ;NO NUMBER. TAKE AS 1.
CPLAY:
; SKIPE DSKFLG ;DISK OUTPUT ?
; JRST DSKPLA ;YES.
;********* SEE EXPORT VERSION AT THIS POINT FOR OUTPUT *********
PUSHJ P,FSBF1 ;SET UP FOR D-A OUTPUT.
PUSHJ P,XGP
MOVE T1,[647004,,0]
ADSMAP T1, ; SET AUDIO SWITCH TEMPORARILY TO DAC (JAM 7/24/75)
; THE OPTIONS WE ASKED FOR ARE TEMPORARY, WAIT FOR
; PAGE TO FINISH, DON'T INTERRUPT WITH MORE PAGES,
; DELAY BEEPS TO END OF XFR.
OUTSTR [ASCIZ /
TO DAC . . ./]
OUTPUT ADCHN,OUTWC
OUTSTR [ASCIZ / DONE!
/]
SOJG T,CPLAY ;REPEAT AS INDICATED BY ARGUMENT.
SETO T1,
ADSMAP T1, ; RESET AUDIO SWITCH CONNECTION TO PERMANENT (JAM 7/24/75)
RELEAS ADCHN,
RELEASE 16,
JRST SCHOWN
REST1: MOVEI TEMPSY
MOVEM BUCTBL
JRST GO
;MORE COMMAND ROUTINES.
CPNT: PUSHJ P,SCOMPA ;INIT. THE COMPILER.
PUSH OSP,[XWD VRBLBT,[XWD VRBLBT,CPNTX#]] ;PUT FAKE VARIABLE IN STACK.
PUSHJ P,ASTMT1 ;COMPILE RIGHT PART OF AN ASSIGNENT STATEMENT.
PUSHJ P,INTERP ;EXECUTE THE CODE.
;***** SEE EXPORT VERSION AT THIS POINT FOR OUTPUT *****************
MOVM A,CPNTX ;GET ITS VALUE.
TLNE A,377000 ;ASSUMING ITS >0, IS IT FLOATING?
FIX A,233000
;***********↑↑↑↑↑↑↑↑↑
CPNT2: PUSHJ P,DECPNT ;PRINT IT.
OUTPUT TTY,0
POP P,A ;GET THING WHICH TERMINATED EXPR. (LEFT ON STACK BY ASTMT1).
CAMN A,SEMICV ;A SEMICOLON ?
JRST SCHOWN ;YES. FORGET IT.
JRST CHOWN ;NO. LOOK AT IT.
CGNUM: TLO FL,SNUMF1 ;DONT PUT NO.'S IN TABLE.
PUSHJ P,SCAN ;LOOK FOR (OPTIONAL) NUMERIC ARGUMENT.
TLNN A,NUMFLG ;IS THERE ONE ?
POPJ P, ;NO.
MOVE T,C ;YES. GET VALUE.
TLNN A,FIXFLG ;IS IT FLOATING ?
FIX T,233000 ;NOT ANY MORE.
;*********↑↑↑↑↑↑↑↑↑↑↑
CGNUM2: POP P,T1 ;GET RETURN ADDR.
JRST 1(T1) ;SKIP ON RETURN.
END GO